perm filename SYM[S,AIL]10 blob
sn#038289 filedate 1973-05-01 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00038 PAGES VERSION 16-2(45)
RECORD PAGE DESCRIPTION
00001 00001
00005 00002 HISTORY
00009 00003 SCAN
00012 00004 BITDATA (SCNWRD -- LISTING CONTROL, ETC.)
00018 00005 DATA (SCANNER PARSE TOKENS)
00024 00006 DSCR main SCANNER Dispatch loop
00029 00007 ID -- RESET FOR SCAN
00037 00008 Comment COMMENT -- throw out everything to next semicolon
00038 00009 DSCR -- USID
00045 00010
00052 00011 PUSH PNT,PNEXTC-1 STRING NUMBER
00056 00012 DSCR STRNG, etc.
00060 00013
00065 00014 DEFCHK:
00075 00015 DSCR SCNUMB -- number scanner
00082 00016 Comment
00084 00017 Comment Print the last character, then stack the result
00087 00018 DSCR CSPEC, SEOL, SEOM, SEOB -- Special handling routines
00091 00019 Cspec, Seol
00092 00020 CALL SPECIAL ROUTINE, BUT FIRST MAKE SURE CHARACTER COUNT IS
00097 00021
00103 00022 END OF BUFFER CODE.
00105 00023 Comment Parameter delimiter or end of message
00111 00024 DSCR ADVBUF -- new input buffer routine
00115 00025 UPDCNT: HRRM C,PNAME UPDATE PNAME
00117 00026 DSCR --HERE IS THE CREFFINF STUFF (STRANGE PLACE N'EST CE PAS?)
00123 00027 DSCR HDR, HDROV
00128 00028 DSCR ENTERS -- make new symbol entry
00132 00029 ↑ENTERS:
00137 00030
00142 00031
00144 00032 JSP A,LNK LINK TO BUCKET LIST
00145 00033 DSCR ADCINS, CREINT, CONINS
00149 00034 DSCR SHASH, NHASH -- look up symbol entries in hashed buckets.
00155 00035 SEMBLK Allocation Routines
00162 00036 RNGVRB, RNGSTR, etc. -- `Ring' Linkage Routines
00165 00037
00168 00038 Mark insertion routine for counter routines
00171 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 202000000055 ⊗;
COMMENT ⊗
VERSION 16-2(45) 5-1-73 BY DCS BUG #MF# SAVE B TO FIX CREF BUG
VERSION 16-2(44) 3-19-73 BY HJS ALLOW TEMPORARY OVERRIDING OF NULL DELIMITERS MODE
VERSION 16-2(43) 3-13-73 BY JRL REMOVE REFERENCES TO WOM,SLS,GAG,NODIS
VERSION 16-2(42) 3-12-73 BY RHT BUG #LS# OWN THINGS GETTING THE WRONG LEVEL INFO
VERSION 16-2(41) 1-31-73 BY HJS ADD NOEMIT, ACKSAV, AND SBSAV FOR EXPR_TYPE
VERSION 16-2(40) 1-17-73 BY HJS BUG #LC# MACRO FORMALS ARE NOT MACRO REDEFINTION
VERSION 16-2(39) 1-17-73
VERSION 16-2(38) 12-11-72 BY HJS DISABLE ENDC PARSER SWITCH TRIGGER IN WHILEC, CASEC, FORC, AND FORLC BODIES
VERSION 16-2(37) 12-2-72 BY HJS SAVE BITS DURING CONDITIONAL COMPILATION AND MACRO DEFINITIONS (CBTSTK AND DBTSTK)
VERSION 16-2(36) 11-20-72 BY JRL FIX SUGG BY R. SMITH AT CHKPRC
VERSION 16-2(35) 11-19-72 BY HJS BUG #JZ# CORRECTION - MACRO REDEFINITION AND RESERVED WORD REDEFINITION IN ENTERS
VERSION 16-2(34) 11-15-72 BY HJS INSERT DEFDLM QSTACK FOR DEFLUK BIT OF FF FOR COMPILE-TIME MACROS WITHIN MACROS
VERSION 16-2(33) 11-5-72 BY DCS BUG #JZ# CHANGE MACRO SCOPE RULES
VERSION 16-2(32) 11-3-72 BY DCS SIMILARLY, ALLOW ALL EXTERNALS TO OVERRIDE
VERSION 16-2(31) 11-2-72 BY DCS BUG #JX# ALLOW INTRNL PROC TO OVERRIDE EXTRNL ONE.
VERSION 16-2(30) 10-24-72 BY HJS EMIT ERR MSG FOR UNINIT MACRO VAR USE
VERSION 16-2(29) 7-5-72 BY DCS BUG #IF# FIX SOME GOERGE BUGS
VERSION 15-6(18-28) 7-5-72
VERSION 15-6(17) 3-10-72 BY DCS REPLACE RING,ULINK MACRO WITH VARIOUS ROUTINES
VERSION 15-6(8-16) 3-9-72
VERSION 15-6(7) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD
VERSION 15-2(6) 2-18-72 BY DCS BUG #GP# CHECK OLD FORMALS AGAINST NEW FORMALS
VERSION 15-2(5) 2-5-72 BY DCS BUG #GJ# ADD LSTON LIST-CONTROL STUFF
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GE# LPSBOT FROM USER TABLE TO COMPILER DATA
VERSION 15-2(2) 12-22-71 BY DCS BUG #FT# PROVIDE LINE NUMBER IF NOT SOS FILE
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
SUBTTL SCAN
LSTON (SYM)
BEGIN SYM
DSCR SCANNER -- get next "ATOM" from source file
CAL PUSHJ from PARSE (or recursively)
PAR PNEXTC is bp to next input char (from file or macro)
SAVCHR, if non-zero, is a scan-ahead char which should
be considered first.
File variables, Listing variables used by I/O part.
Define stack, variables, macro semantics used when
recurring into macros
RES The ATOM will be either:
1. An operator or other character atom, in which case
the Parse token representing it will be placed in the
parse stack, a 0 in the generator stack (null entry).
2. A reserved word, in which case the Parse token will be
placed on the parse stack from the word's symbol
entry, and again a null semantic entry will be stacked.
3. An IDENTIFIER, in which case the Parse token for the appro-
iate class of IDs will appear on the parse stack, the
Semantics for the symbol on the generator stack. If the
symbol is undefined, a 0 is represents null Semantics.
4. A STRING or numeric constant. These entities are ENTERed
in their respective symbol tables if previously
undefined, and the stacks are set up as above.
In all cases, the semantic entry will be repeated in the cell
NEWSYM. In those cases where a hash was made, the
MOVE or MOVS instr to fetch the list on which the symbol
appears (or will appear after ENTERy) is located in
the cell HPNT. For string constants or identifiers, the
string identifier is left in PNAME, PNAME+1. For numeric
arguments, the value is left in SCNVAL. DBLVAL is zeroed
in these cases.
SID SCANNER uses temporary ACs indiscriminately, so look out for it.
Many variables are changed as a result of calling SCANNER.
⊗
BITDATA (SCNWRD -- LISTING CONTROL, ETC.)
Comment ⊗ SCAN table -- good bits that make the whole thing work ⊗
↑↑LSTEXP←←400000 ;ON IF "⊂"-"⊃" PAIRS TO BE PRINTED
↑↑MACEXP←←200000 ;EXPAND MACRO TEXTS
↑↑MACLST←←100000 ;LIST MACRO NAMES BEFORE EXPANSION
↑↑LINESO←← 40000 ;ON IF LINE NUMBERS SHOULD BE PRINTED
↑↑PCOUT ←← 20000 ;ON IF PCNT SHOULD BE PRINTED
↑↑CREFIT←← 10000 ;ON IF A CREF S HAPPENING
↑↑MACIN ←← 4000 ;ON IF IN A MACRO EXPANSION
↑↑EOFOK ←← 2000 ;ON IF CAN GET EOF WITHOUT FATALITY
↑↑BACKON←← 1000 ;ON IF LISTING BACK ON AFTER PARAM RESCAN
↑↑LOKPRM←← 400 ;ON IF LOOKING FOR POSSIBLE MACRO PARAM
↑↑RDYPRM←← 200 ;GETTING READY FOR MACRO PARAM (RANSCN)
↑↑INLIN ←← 100 ;TREAT @ AS DELIMITER IN IN-LINE CODE
↑↑INSWT ←← 40 ;WE'RE SCANNING A SWITCHED-TO SOURCE FILE
↑NOLIST←← 1 ;ON IN RH IF NO LISTING HAPPENING NOW
BITDATA (SCANNER TABLE)
SPCL ←←400000 ;NOT A LETTER OR DIGIT
ATSIGN←← 20000 ;@ -- REAL EXPONENT COMING
AOSSOS←← 20000 ;BIT DIFFERENTIATING BETWEEN AOS AND SOS FOR NESTING
; DELIMITERS COUNT
DOT ←← 10000 ;. -- DECIMAL POINT
NUMB ←← 4000 ;NUMBER OR NUMBER PART (ONE OF ABOVE TWO)
DIG ←← 2000 ;0 THRU 9
LETDG ←← 1000 ;REQUIRES SPECIAL TREATMENT
QUOTE ←← 400 ;" -- STRING CONSTANT DELIMITER
↑NEST ←← 200 ; NESTABLE CHARACTER
↑LNEST ←← 100 ; LEFT NESTED CHARACTER
QUOCTE←← 40 ;' -- OCTAL NUMBER COMING
; BITS FOR NUMBER SCANNER
INTOV ←←200000 ;INTEGER OVERFLOW
REALOV←←100000 ;REAL OVERFLOW
EXPNEG←← 40000 ;NEGATIVE EXPONENT
NUMNST ←←3 ; NUMBER OF NESTABLE CHARACTERS
RPAROF ←←2 ; RIGHT PAREN OFFSET FOR LOCNST ENSTRY
↑NUMCHA ←←200 ; NUMBER OF CHARACTERS
↑DELNUM ←←4 ; NUMBER OF DELIMITERS AS INPUT TO REQ. DEL.
TABCONDATA (SCANNER CHARACTER TABLE)
DEFINE IGL <XWD SPCL,IGLCHR>
DEFINE OPER <.-SCNTBL>
DEFINE LTR <XWD LETDG,.-SCNTBL>
DEFINE NESTED <<XWD NEST,0>>
DEFINE LNESTD <<XWD NEST+LNEST,0>>
↑SCNTBL:
XWD SPCL,SEOB ;0 -- END OF BUFFER
LTR ;↓ α BETA
LTR
LTR
RAND ↔ RNOT ↔ RIN ;∧ ¬ ε
REPEAT 2,<LTR > ;π λ
0 ;TAB
XWD SPCL,SEOL ;LF -- END OF LINE
0 ;VTAB
XWD SPCL,SEOP ;FF -- END OF PAGE
0 ;CARRIAGE RETURN
RINF ; ∞ -- INFINITY.
LTR ; ∂ ⊂ ⊃
REPEAT 2,<LTR >
RINTER ↔ RUNION ; ∩ ∪
LTR ↔ LTR ; ∀ ∃
RXOR↔RSWAP ; ⊗ ↔
LTR ;UNDERLINE ?
LTR ↔ RAND ; → ∧
RNEQ ↔ RLEQ ↔ RGEQ ↔ REQV ↔ ROR ;≠ ≤ ≥ ≡ ∨
0 ;SPACE
XWD LETDG,30 ;! -- SAME AS UNDERLINE.
XWD QUOTE,.-SCNTBL ; "
LTR ↔ LTR ;# $
TPRC ; %
TANDD ;&
XWD LETDG+NUMB+QUOCTE,.-SCNTBL ; '
LNESTD+TLPRN ; (
NESTED+TRPRN ; )
TTIMS ↔ TPLUS ↔ TCOMA ↔ TMINUS ; *+,-
XWD LETDG+NUMB+DOT,.-SCNTBL ; .
TSLSH ; /
REPEAT 12,<XWD LETDG+NUMB+DIG,.-SCNTBL> ;DIGITS
TCOL ↔ TSEMI ; : ;
TLES ; <
TEQU ; =
TGRE ; >
TQUES ;?
XWD LETDG+NUMB+ATSIGN,.-SCNTBL ; @
REPEAT =26,<LTR> ;UPPER CASE LETTERS
LNESTD+TLBR ; [
LTR ; TILDE
NESTED+TRBR ; ]
TUPRW ↔ TLARW ↔ RASSOC ; ↑ ← `
REPEAT =26,<LTR-40> ;LOWER CASE LETTERS
LNESTD+RSETO ; {
TVERT ; |
RSETC ; }
NESTED+RSETC ; }
; 175 AND 176 WILL BOTH BE CURLY BRACKETS FOR A WHILE.
XWD SPCL,EOM ;177 -- END MACRO OR PARAM
ENDSCN←.
DATA (SCANNER PARSE TOKENS)
COMMENT ⊗
These variables provide symbolic access to the PARSE token
numbers for several delimiter characters -- they are used in
those cases where the SCANNER or some EXEC needs to examine
a value directly
⊗
%ATS: TINDR ;BITS FOR @ DELIMITER IN INLINE(SEE SCNUMB)
%COMMENT: RCOMME+1B0
↑↑%ID: TI
%NUMCON: TICN ;ARITHMETIC CONSTANT.
%SEMICOL: TSEMI
↑↑%STCON:TSTC ;STRING CONSTANT.
ZERODATA (SCANNER VARIABLES)
↑↑DEFRN2: 0 ;TEMP RING-VARIABLE WHILE SCANNING MACRO ACTUAL PARAMS
;FLTVAL -- collect floating point equiv while scanning number
↓FLTVAL: 0
COMMENT ⊗
HPNT, HSPNT -- When the hashing routines (SHASH, NHASH) locate the
right bucket pointer in the appropriate bucket Semblk, they create
a [HRR LPSA,addr] or [HLR LPSA,addr] instruction which will fetch
this pointer, and put it into HPNT -- also leaving it in LPSA. They
then execute the instruction to begin their lookup phases. ENTERS
again uses this pointer when adding a new Semblk to a bucket -- first
as is, to fetch the old pointer, then modified to HRRM or HRLM, to
update the bucket.
HSPNT is the saved HPNT value for the last string constant scanned.
The "string constant as comment" EXEC uses it to remove the constant
from the bucket (provided, of course, that it hasn't also been used
as a string constant).
⊗
↑HPNT: 0
↑HSPNT: 0
↑↑LOCMBD: BLOCK 2 ; MACRO BODY DELIMITERS BLOCK
↑↑LOCMPR: BLOCK 2 ; MACRO PARAMETER DELIMITERS BLOCK
BAKDLM: 0 ; A FLAG WHICH IS SET TO -1 IF DLMSTG IS ON
; (I.E. ONE WANTS A DELIMITED MACRO BODY)
; AND QUOTES ARE USED INSTEAD BECAUSE A
; REQUIRE NULL DELIMITERS STATEMENT WAS NOT
; USED.
↑↑CURMBG: 0 ; CURRENT MACRO BODY BEGIN DELIMITER
↑↑CURMED: 0 ; CURRENT MACRO BODY END DELIMITER
↑↑CURPBG: 0 ; CURRENT PARAMETER BEGIN DELIMITER
↑↑CURPED: 0 ; CURRENT PARAMETER END DELIMITER
↑↑DELSTK: 0 ; DELIMITER "BLOCK-STRUCTURE" STACK
↑↑LOKDLM: 0 ; DLMSTG (LOOKING FOR DELIMITERS FLAG) QSTACK
↑↑DEFDLM: 0 ; DEFLUK (SCANNING A MACRO BODY OR LOOKING FOR
; ACTUAL PARAMETERS) QSTACK
↑↑CBTSTK: 0 ; POINTER TO QSTACK FOR SAVING BITS WHILE SCANNING
; CONDITIONAL COMPILATION EXPRESSIONS
↑↑DBTSTK: 0 ; POINTER TO QSTACK FOR SAVING BITS WHILE SCANNING
; MACRO DEFINITIONS
↑↑ENDCTR: 0 ; POINTER TO QSTACK INDICATING WHETHER OR NOT ENDC
; SHOULD TRIGGER A PARSER SWITCH (NO IF ONE IS
; SCANNING A WHILEC, CASEC, FORC, OR FORLC BODY)
↑↑REQDLM: 0 ; REQUIRE DELIMITER STATEMENT SEEN FLAG
↑↑SWBODY: 0 ; SPECIAL DELIMITER DEFINITION SEEN
↑↑BNSTCN: 0 ; NESTED DELIMITER COUNT
↑↑LOCNST: BLOCK NUMNST ; NESTABLE CHARACTERS BLOCK
↑↑NSTABL: BLOCK NUMCHA ; NESTABLE CHARACTERS ADDRESS INDEX BLOCK
↑↑NOEMIT: 0 ; DON'T EMIT CODE FLAG FOR THE EMITTER
↑↑ACKSAV: BLOCK 13 ; SAVE ACKTAB HERE WHILE EVALUATING EXPR_TYPE
↑↑SBSAV: BLOCK 13 ; SAVE $SBITS CORRESPONDING TO ACKSAV VALUES WHILE
; EVALUATING EXPR_TYPE (AVOIDS HARMFUL SIDE
; EFFECTS OF CODE GENERATORS)
↑↑ADPTSV: 0 ; ADEPTH VALUE BEFORE EXPR_TYPE PROCESSING
↑↑PCNTSV: 0 ; PCNT VALUE BEFORE EXPR_TYPE PROCESSING
↑↑SDPTSV: 0 ; SDEPTH VALUE BEFORE EXPR_TYPE PROCESSING
↑↑RSTDLM: 0 ; TEMPORARY OVERRIDIN OF NULL DELIMITERS MODE FLAG
ENDDATA
DSCR LSTDPB
⊗
DEFINE LSTDPB < ;OUTPUT CHAR TO LISTING FILE IF REQD
TRNN TBITS2,NOLIST ;IS LISTING HAPPENING, BABY?
IDPB B,LPNT ;YES, DO THE REQUIRED THING
>
DSCR main SCANNER Dispatch loop
RES gets first char from SAVCHR or PNEXTC, dispatches to
routine to handle what it found (IDENT, STRING, DELIM, etc.)
⊗
↑SCANNER:
MOVE TBITS2,SCNWRD ; SET UP SCANNER PARAMS
TLZE FF,BAKSCN ;IS SCANNER BACK ONE CHARACTER ??
JRST GOAGAIN ; DO IT.
MOVE USER,GOGTAB ;USER DATA TABLE ADDR FOR STRING STUFF
TLNE TBITS2,INLIN ;SPECIAL START_CODE FEATURE?
SETZM PNAME ;YES, ASSURE NO PNAME USED
MOVEI C,0 ;WILL COUNT CHARS FOR IDENTS
SKIPE B,SAVCHR ;IS ANYTHING LEFT OVER?
JRST SPCHAR ;YES, DISPATCH AS FIRST CHAR
TLNN FF,PRMSCN ;SCANNING MACRO PARAMETERS?
JRST DISPT ; NO
TRNA ;SKIP IDPB
IDPB B,LPNT ;TO LISTING FILE
DSPRM: ILDB B,PNEXTC ;SKIP IGNORABLE CHARACTERS
SKIPGE A,SCNTBL(B) ;ANYTHING SPECIAL REQUIRED?
PUSHJ P,(A) ;YES, DO IT
JUMPE A,DSPRM-1(TBITS2) ;MAYBE LIST, GET NEXT IGNORABLE
DSPR1: TLO FF,PRMXXX ;SET SPECIAL PARAM SCANNING BIT
TLNE A,QUOTE ;DOES HE WANT COMPLETE FREEDOM?
JRST STRLST ; YES, GIVE IT TO HIM (FIRST LIST `"')
PUSHJ P,INSET ;NO, SPECIAL MODE -- "," OR ")" WILL BREAK
JRST BAKSTR ;AROUND QUOTE DELETION
IDPB B,LPNT ;TO LIST FILE
DISPT: ILDB B,PNEXTC ;GET FIRST CHAR
SKIPGE A,SCNTBL(B) ;GET GOOD BITS, CHECK SPECIAL
PUSHJ P,(A) ;SPECIAL, HANDLE IT
JUMPE A,DISPT-1(TBITS2) ;BLANKS AND OTHER IGNORABLES
MOVE SBITS2,LPNT ;SAVE IN CASE BACKUP MUST HAPPEN
STRLST: LSTDPB ;TO LISTING FILE IF REQD
SPCHAR: SETZM SAVCHR ;NOTHING LEFT OVER YET
SETZM LSTCHR
JUMPL B,[TLZN TBITS2,EOFOK ;OK FOR EOF HERE?
ERR <FATAL END OF SOURCE FILE> ;NO
MOVE A,%EOFILE ;YES, RETURN `EOF'
JRST CHAROUT] ;NULL SEMANTICS
SKIPN A,SCNTBL(B) ;GET GOOD BITS (DON'T DISPATCH AGAIN!)
JRST DISPT ; IGNORABLE, FIND ONE THAT ISN'T
SKIPE DLMSTG ; LOOKING FOR SPECIALLY DELIMITED STRING?
CAME B,CURMBG ; POSSIBLY, MACRO BODY BEGIN DELIMITER?
JRST CONCHK ; GO DO A NORMAL SCAN
SETZM BNSTCN ; SET DELIMITER NEST COUNT TO ZERO
JRST STRNG ; GET MACRO BODY
CONCHK: TLNE A,LETDG ; LETTER OR NUMBER?
JRST CHKNUM ; YES, GO SEE WHICH
TLNN A,QUOTE ;STRING CONSTANT?
JRST CHAROUT ; NO, OPERATOR, OUTPUT ID, NULL SEMANTICS
SKIPN DLMSTG ; HAS A QUOTE BEEN USED TO DELIMIT A MACRO
; BODY WHILE IN REQUIRE DELIMITERS MODE?
JRST STRNG ; NO, SCAN A STRING CONSTANT IN NORMAL MODE.
SETZM DLMSTG ; YES, TURN OFF DLMSTG FLAG AND TURN ON
SETOM BAKDLM ; BAKDLM FLAG SO THAT WHEN SCANNING THE
JRST STRNG ; MACRO BODY A QUOTE WILL BREAK THE SCAN.
CHKNUM: TLNE A,NUMB ;NUMBER PART?
JRST SCNUMB ; YES, SCAN NUMBER
; ID -- RESET FOR SCAN
DSCAN: PUSHJ P,INSET ;CLEAR PNAMES, COUNT, ALIGN TO FW
MOVE TBITS2,SCNWRD ;MAKE SURE THE BITS ARE RIGHT
TLO TBITS2,EOFOK ;EOF CAN END THE WORLD WITHOUT KILLING IT
MOVEI C,1 ;ACCOUNT FOR FIRST CHARACTER
TRNA
IDPB B,LPNT ;TO LISTING FILE
IDSCAN: IDPB A,TOPBYTE(USER) ;STORE CONVERTED CHAR
ILDB B,PNEXTC ; GET NEXT CHARACTER
SKIPGE A,SCNTBL(B) ;GET GOOD BITS, CHECK SPECIAL
PUSHJ P,CSPEC ;SPECIAL, DO SOMETHING
TLNE A,LETDG ;DONE WITH ID?
AOJA C,IDSCAN-1(TBITS2) ;NO, GO GET MORE.
Comment ⊗ Now the symbol is in string space, pointed to
by the string descriptor in PNAME, etc. Store the
count, make the lookup, set up the results ⊗
CAIE B,12 ;IF LF, ALREADY HANDLED, LEAVE SAVCHR 0
MOVEM B,SAVCHR ;SAVE THE BREAK BITS (0 IF BLANK OR CR BROKE)
MOVEM B,LSTCHR ;ALSO HERE ANY TIME
TLZ TBITS2,EOFOK ;DONE WITH THIS MODE
PUSHJ P,UPDCNT ;UPDATE PNAME CNT, REMCHR CNT, COLLECT IF NECC.
MOVE LPSA,SYMTAB ;TRY TO FIND IT
PUSH P,B ;SAVE FOR LATER
PUSHJ P,SHASH ;LIKE SO
POP P,B ;GET IT BACK
MOVEM TBITS2,SCNWRD ;SAVE ANY CHANGES
TLNE TBITS2,LOKPRM ;STACK IT?
POPJ P, ; NO, IN STRING CONSTANT MODE
; GET RELEVANT DATA TO STACKS
MOVE A,%ID ;IT IS AN IDENTIFIER
SKIPG LPSA,NEWSYM ;IF IT IS UNDEFINED,
JRST LSTACK ; PUSH TO STACKS
MOVE TBITS,$TBITS(LPSA)
;IF CREFFING, DO IT NOW...
TLNE FF,CREFSW ;
PUSHJ P,LCREFIT
JUMPGE TBITS,USID ; NO, USER ID
LSTDPB
MOVE A,TBITS ;RESULTANT PL-ID
MOVEI LPSA,0 ;MAKE NULL SEMANTICS
CAMN A,%COMMENT ; COMMENT?
JRST CHKSAV ; YES, GO PROCESS IT
TLNE TBITS,CONRES ; PARSER SWITCHING RESERVED WORD?
SKIPN SWCPRS ; YES, NEED TO SWITCH PARSERS?
JRST STACK ; NO, RETURN RESERVED WORD
TLNE TBITS,DEFINT ; PARSER INTERRUPT (I.E. NO SWITCHING)?
JRST[SKIPE NODFSW ; DEFER DEFINE HANDLING FOR BLOCK EXECUTION?
JRST STACK ; YES, RETURN RESERVED WORD
MOVE TEMP,SCNNO ; YES, SAVE NUMBER OF SCANS REMAINING IN LEFT HALF
MOVE B,PCSAV ; OF TOP OF PRODUCTION STACK, UNPACK $TBITS ENTRY
HRLM TEMP,(B) ; OF THE RESERVED WORD TO GET AN INDEX OF ADDRESS
JRST CONDAD] ; TO PUSHJ TO, AND SET SCNNO TO ONE.
TLNE TBITS,CONDIN ; CHECK IF ENDC HAS OCCURRED AS THE END OF A WHILEC,
JRST ENDCOK ; CASEC, FORC, OR FORLC BODY AND IF SO, THEN DO NOT
HLRZ TEMP,ENDCTR ; SWITCH PARSERS. ENDCTR IS A POINTER TO A QSTACK
SKIPE (TEMP) ; INDICATING SUCH INFORMATION.
JRST STACK ;
ENDCOK: SKIPE PRSCON ; DETERMINE WHICH PARSER ONE IS CURRENTLY IN AND
SKIPA TEMP,[CGPSAV-1] ; GET THE ADDRESS TO SAVE ITS PARSER DESCRIPTOR.
MOVEI TEMP,SGPSAV-1 ; SAVE SEMANTIC STACK POINTER, PARSE STACK POINTER,
PUSH TEMP,GPSAV ; NUMBER OF SCANS REMAINING IN LEFT HALF OF TOP OF
PUSH TEMP,PPSAV ; PRODUCTION STACK, PRODUCTION STACK POINTER,
MOVE SP,SCNNO ; CURRENT SCNWRD, AND A POINTER TO THE SCNWRD
MOVE B,PCSAV ;
HRLM SP,(B) ; STACK.
PUSH TEMP,PCSAV ;
MOVE B,SCWSV ;
MOVEM TBITS2,(B) ; SAVE SCNWRD
PUSH TEMP,SCWSV ;
SKIPE PRSCON ; DETERMINE WHICH PARSER IS TO BE RESUMED AND GET
SKIPA TEMP,[XWD -1,SSCWSV] ; THE ADDRESS OF ITS PARSER DESCRIPTOR.
HRROI TEMP,CSCWSV ;
POP TEMP,B ; RESTORE SCNWRD STACK POINTER
TLNE TBITS,CONDIN ; IF ONE IS SWITCHING PARSERS VIA A PUSHJ INSTEAD OF
JRST[TLZ TBITS2,INLIN ; PROPER SCANNING OF INLINE STARTCODE. COMPENSATE
TRO TBITS2,NOLIST ; FOR NOT POPPING TEMP.
PUSH B,TBITS2 ;
JRST .+2] ;
MOVE TBITS2,(B) ; RESTORE SCNWRD AND TBITS2
MOVEM B,SCWSV ;
MOVEM TBITS2,SCNWRD ;
MOVEM SBITS2,LPNT ; DON'T LIST PARSER SWITCH TRIGGERING RESERVED WORDS
POP TEMP,B ; RESTORE CONTROL STACK POINTER
POP TEMP,SP ; RESTORE PARSE STACK POINTER. MUST BE IN AC AS
MOVEM SP,PPSAV ; WELL AS IN MEMORY.
POP TEMP,GPSAV ; RESTORE SEMANTIC STACK POINTER
SETCMM PRSCON ; COMPLEMENT PARSER IN CONTROL FLAG
MOVEI C,1001 ; ASSUME A RESUME TYPE SWITCH
TLNN TBITS,CONDIN ; RESUME TYPE SWITCH?
JRST SWTPRE ; YES
CONDAD: HLRZ C,TBITS ; CONDAD IS CALLED WITH THE $TBITS ENTRY
TRZ C,RES+CONBTS ; OF A PARSER INTERRUPT RESERVED WORD IN
LSH C,-IF0SHF ; TBITS. IT INSERTS THE ADDRESS OF THE
MOVEI C,PRODGO(C) ; PRODUCTION WHICH ONE IS TO EXECUTE NEXT
PUSH B,C ; IN THE PRODUCTION CONTROL STACK. TBITS
MOVEI C,4001 ; IS UNPACKED TO GET AN INDEX TO A TABLE
; STARTING AT PRODG0 (BITS 6-8). SET
; REMAINING NUMBER OF CALLS TO SCANNER TO
; ONE SO THAT THE PARSER WILL NOT SCAN
; AGAIN AND SET A BIT TO DO A PUSHJ.
SWTPRE: MOVEM B,PCSAV ; RESTORE CONTROL STACK POINTER IN CORE
MOVEM C,SCNNO ; SET REMAINING NUMBER OF CALLS TO SCANNER
JRST STACK ; GO STACK
Comment ⊗ COMMENT -- throw out everything to next semicolon
⊗
CHKSAV: MOVE B,SAVCHR ;BE SURE SAVCHR IS NOT ";"
SETZM SAVCHR
SETZM LSTCHR
SKIPGE A,SCNTBL(B) ;GET BITS, CHECK SPECIAL
PUSHJ P,(A) ;SPECIAL, GET PAST PROBLEM
JRST COMLUP ;GET THEM ALL
IDPB B,LPNT ;TO LISTING FILE
COMLUP: CAIN B,";" ;DONE?
JRST SCANNER ; YES
COMILD: ILDB B,PNEXTC ;GET NEXT CHAR
SKIPGE A,SCNTBL(B) ;USUAL
PUSHJ P,(A)
JRST COMLUP-1(TBITS2) ;GO PUT AWAY, GET ANOTHER
DSCR -- USID
DES An identifier has been found. If it is a macro name, go
expand it. Otherwise call TYPDEC routine to provide the
proper parse token for this identifier (differentiates
ARRAYS from PROCEDURES from STRINGS from ....
SEE TYPDEC in GEN, for providing correct parse token.
⊗
USID: TLNE TBITS,DEFINE ;NEED TO EXPAND MACRO?
JRST DEFRG ;YES
GOHEQ: LSTDPB
PUSHJ P,TYPDEC
JRST STACK
DSCR DEFRG -- prepare to expand a macro
DES The Ident is a DEFINE Ident. The steps are
1. Save current Parse and Semantic Stack state,
other state which will be destroyed.
2. If no parameters to get, go to step 5.
3. Get a parameter (special form string constant,
see manual), via SCANNER (recursive call, also
ENTERS); place on special VARB-RING whose ring
variable is VARB, and whose starting element is
in DEFRN2.
4. If comma, go to step 3 for more, else check for
right paren.
5. Save previous SCANNER information on DEFPDP stack,
set up DEFRNG for actuals, put macro body descrip-
tor in PNEXTC, restore stacks and VARB, etc.
6. Handle macro expansions in listing.
7. JRST to SCANNER for another try with the new PNEXTC
⊗
DEFRG: HLRZ A,%TLINK(LPSA) ; CHECK IF MACRO HAS BEEN INITIALIZED.
JUMPN A,DEFRG1 ;
ERR <MACRO WAS NOT INITIALIZED - INITIALIZE TO ZERO AND CONTINUE> ;
SETZM A ; SOLVES PROBLEMS SUCH AS:
PUSHJ P,CREINT ; DEFINE NAME=NAME+1 WITHOUT A DEFINE NAME=0
MOVE LPSA,PNT ; OR ANOTHER INITIAL VALUE.
MOVE A,%NUMCON ;
JRST STACK ;
DEFRG1: ;CREATE A NEW DEFINE ELEMENT
TLNE FF,NOMACR ;EXPAND MACROS??
JRST [LSTDPB↔MOVE A,%ID ↔ JRST STACK];NO -- USER ID.
; IF WE DON'T WANT TO SEE MACRO NAMES IN OUTPUT LISTING, BACK UP OUTPUT PTR.
; ALSO TURN OFF LISTING FOR PARAMS
TLNN TBITS2,MACLST ;LIST MACRO NAMES?
JRST [MOVEM SBITS2,LPNT ;NO, NULLIFY ALL TO DATE
TRO TBITS2,NOLIST ;LIST NO MORE FOR A WHILE
JRST .+1]
PUSHJ P,SCNACT ; GET ACTUAL PARAMETER LIST
PUSHJ P,ACPMED ; FINISH OFF THE MACRO CALL PREPARATION
JRST SCANNER ; TRY AGAIN (SCAN THE MACRO BODY!)
; SPECIAL DELIMITER MODE ACTUAL PARAMETER SCANNING ROUTINE
SCNPMR: PUSHJ P,INSET ; SET UP STRING SPACE ENTRY
TRNA ; SKIP
IDPB B,LPNT ; LIST MAYBE
DSPRMS: ILDB B,PNEXTC ; GET NEXT CHAR.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,(A) ; DO IT
JUMPE A,DSPRMS-1(TBITS2) ; AGAIN IF IGNORABLE
CAME B,CURPBG ; PARAMETER BEGIN DELIMITER?
JRST BALCHK ; NO, NESTED-BALANCED COMMA OR RPAR WILL BREAK
LSTDPB ; LIST IT?
SETZM BNSTCN ; SET NEST COUNT TO ZERO
JRST PSCAN+3 ; CONTINUE SCAN
PSCAN: LSTDPB ; LIST IT?
IDPB B,TOPBYTE(USER) ; DEPOSIT
ILDB B,PNEXTC ; GET NEXT CHAR.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,(A) ; DO IT
CAMN B,CURPED ; PARAMETER END DELIMITER?
JRST SPMEND ; YES, CHECK IF DONE
CAMN B,CURPBG ; PARAMETER BEGIN DELIMITER?
AOS BNSTCN ; INCREMENT NEST COUNT
AOJA C,PSCAN ; SCAN AGAIN
SPMEND: SOSL BNSTCN ; DECREMENT NEST COUNT AND CHECK IF DONE
AOJA C,PSCAN ; NO, SCAN AGAIN
ILDB B,PNEXTC ; ADVANCE CHAR. TO KEEP IN SYNCH.
SKIPGE A,SCNTBL(B) ; SPECAIL?
PUSHJ P,(A) ; DO IT
JRST ENDSTR ; GO TO END
DEPOSB: CAIN B,")" ; RIGHT PAREN WITH NONZERO NEST COUNT?
SOS LOCNST+RPAROF ; DECREMENT NEST COUNT
DEPOSA: LSTDPB ; LIST IT?
IDPB B,TOPBYTE(USER) ; DEPOSIT
AOJ C, ; INCREMENT CHARACTER COUNT
ILDB B,PNEXTC ; GET NEXT CHAR.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,(A) ; DO IT
BALCHK: CAIE B,"," ; END OF PARAMETER?
CAIN B,")" ;
JRST ENDCHK ; POSSIBLY, GO CHECK
TLNN A,NEST ; NESTED CHARACTER?
JRST DEPOSA ; NO, GO DEPOSIT
MOVE TEMP,[AOS LOCNST-1(LPSA)] ; SET UP INSTRUCTION TO UPDATE APPROP. NEST COUNT
TLNN A,LNEST ; LEFT NESTED?
TLO TEMP,AOSSOS ; NO, CHANGE INSTRUCTION TO SUBTRACT
HRRZ LPSA,NSTABL(B) ; LOAD CHAR'S NESTED COUNT INDEX
XCT TEMP ; MODIFY COUNT
JRST DEPOSA ; GO DEPOSIT
ENDCHK: MOVEI TEMP,NUMNST-1 ; SET UP COUNT
EDLOOP: SKIPN LOCNST(TEMP) ; NEST COUNTEQUAL ZERO?
SOJGE TEMP, EDLOOP ; YES, AND TRY NEXT IF NOT DONE
JUMPGE TEMP,DEPOSB ; GO DEPOSIT IF NOT ALL NEST COUNTS EQUAL ZERO
JRST ENDSTR ; GO TO END
DSCR -- SCNACT
DES This procedure is used to scan a list of actual parmeters for a macro
or a conditional compilation FORLC statement. When the latter happens
SCNACT is called from the EXEC routine GETACT which appears in GEN.
FORLC statements have a body which is scanned as many times as one has
parameters in the actual list; in each case a different actual is used
as the parameter.
PAR LPSA contains the semantics of the macro name or macro pseudonym in
case a FORLC list is being scanned (address of semblk of name).
RES DEFRN2 contains the address of the first actual parameter in the list.
⊗
↑SCNACT: PUSH P,LPSA ;SAVE SEMANTICS OF DEFINE SYMBOL
PUSH P,VARB ;WILL MAKE NEW ONE FOR MACRO ARGUMENTS
PUSH P,PPSAV ;SAVE THE STACKS
PUSH P,GPSAV
SETZM DEFRN2 ;INITIALIZE FOR NEW MACRO
SETZM VARB
HLRZ TEMP,$VAL(LPSA) ;ANY PARAMETERS NEEDED?
JUMPE TEMP,NOPRMS ; NO
MOVEM TBITS2,SCNWRD ;NOTE CHANGES
SCNAGN: PUSHJ P,SCANNER ;LOOKING FOR "("
MOVE TEMP,(SP) ;SYNTAX OF SCANNED ELEMENT
POP P,GPSAV ;KEEP STACKS IN SYNCH
POP P,PPSAV
ADD P,X22
CAMN TEMP,%STCON ; A SPECIAL DELIMITER DECLARATION?
SKIPE SWBODY ; YES, COULD WE POSSIBLY HAVE SEEN A SPEC DEL DECL.
; I.E. DID WE SEE ONE ALREADY?
JRST TSLPRN ; NO, GET LEFT PAREN.
SKIPN REQDLM ; TRYING TO OVERRIDE NULL DELIMITERS MODE?
SETOM RSTDLM ; YES, SET APPROPRIATE FLAGS
SETOM REQDLM ;
SETOM SWBODY ; SET SWITCH DELIMITER DECLARATION FLAG
MOVE TEMP,[XWD -2,2] ; SET UP A COUNT
MOVE PNT,$PNAME+1(LPSA) ; PNT HAS BYTE POINTER TO DELIM. STRING
HRRZ LPSA,$PNAME(LPSA) ; LPSA HAS DELIMITER STRING LENGTH
PUSHJ P,GETDL2 ; GET SPECIAL DELIMITER DECLARATION
JRST SCNAGN ; GO BACK AND GET LEFT PAREN.
TSLPRN: CAME TEMP,[TLPRN&17777777] ;PARAMS?
ERR <MISSING "(" IN MACRO CALL> ; NO
MOVEI B,"("
LSTDPB
TLO FF,PRMSCN ; PRIME THE SCANNER FOR PARAMETER
PUSHJ P,FFPUSH ; SAVE OLD DEFLUK BIT OF FF AND TURN IT ON IN FF
PRMLUP: SKIPN REQDLM ; IN SPECIAL DELIMITER MODE?
JRST PRMOLD ; NO
PUSHJ P,SCNPMR ; YES, GET THE PARAMETERS
TRNA
PRMOLD: PUSHJ P,SCANNER ;GET A PARAMETER
POP P,GPSAV ;SYNCH STACK
POP P,PPSAV
ADD P,X22
; WE KNOW RESULT IS STRING CONSTANT, SCANNER WILL RETURN NO OTHER
SKIPN TEMP,DEFRN2 ;PUT → FIRST ARG IN DEFRN2
MOVE TEMP,NEWSYM
MOVEM TEMP,DEFRN2
PUSHJ P,SCANNER ;GET NEXT PUNCTUATION
MOVE TEMP,(SP)
POP P,GPSAV
POP P,PPSAV
ADD P,X22 ;SYNCH STACKS
CAMN TEMP,[TCOMA&17777777] ;LOOPING?
JRST PRMLUP ;YES
CAME TEMP,[TRPRN&17777777] ;DONE?
ERR <MISSING "," OR ")" IN MACRO CALL>
TLZ FF,PRMSCN ; DONE WITH THESE
PUSHJ P,FFPOP ; RESTORE DEFLUK BIT OF FF
SKIPE REQDLM ; IN SPECIAL DELIMITER MODE?
SKIPN SWBODY ; YES, HAVE TO REVERT TO OLD DELS?
JRST NOPRMS ; NO
SETZM SWBODY ; RESET SWITCH DELIMITER DECLARATION FLAG
SKIPN RSTDLM ; RESTORING NULL DELIMITERS MODE?
JRST .+4 ; NO
SETZM RSTDLM ; YES, RESTORE APPROPRIATE FLAGS
SETZM REQDLM ;
JRST NOPRMS ;
HRROI TEMP,LOCMPR+1 ; GET RESTORING ADDRESS
POP TEMP,CURPED ; RESTORE START DEL.
POP TEMP,CURPBG ; RESTORE END DEL.
NOPRMS: POP P,GPSAV ; GET SEMANTIC STACK BACK
POP P,PPSAV ; GET PARSE STACK BACK
POP P,VARB ; GET OLD VARB BACK
POP P,LPSA ; SEMANTICS FOR DEFINE
MOVE SP,PPSAV ; RESTORE SP IN CASE IT GOT FOULED UP IN
; SCANNER CALLS
POPJ P, ; RETURN
DSCR -- ACPMED
DES ACPMED prepares for a macro call once the actual parameters have been
scanned. It is also used to prepare for the first instantiation of the
body of a conditional compilation WHILEC, CASEC, FORC, or FORLC statement.
PAR LPSA contains the semantics of the macro name or macro pseudonym in
case a conditional compilation WHILEC, CASEC, FORC, or FORLC body is
being scanned for the first time. DEFRN2 contains the address of the
actual parameter list in case of a FORLC statement, the address of the
loop variable semblk in case of a FORC statement, and zero in the case
of a WHILEC or CASEC statement.
RES At the end of this procedure one has effectively switched PNEXTC and
PNEXTC-1 to scan the macro body or the conditional compilation body.
Relevant information is saved on the DEFPDP stack.
⊗
↑ACPMED: MOVE PNT,DEFPDP ;RESTORE NOW
PUSH PNT,DEFRNG ;SAVE OLD RING OF PARAMETERS
PUSH PNT,PNEXTC-1 ;STRING NUMBER
PUSH PNT,PNEXTC ;INSTEAD SAVE THOSE WHICH
PUSH PNT,SAVCHR ; PARAMETERS
MOVEM PNT,DEFPDP
MOVE PNT,PLINE ;WILL SAVE IN IPLINE IF LEAVING INPUT LEVEL
MOVEW DEFRNG,DEFRN2 ;PERMANENT LODGING FOR DEFINE RING
PUSHJ P,CONTXT ; SET UP THE SCAN POINTERS
; DECIDE WHETHER MACRO EXPANSION SHOULD BE LISTED.
MOVEI B,"⊂" ;MARK EXPANSION IF MACRO NAME
TLNE TBITS2,LSTEXP ; IS ALSO BEING LISTED
IDPB B,LPNT ; (NEVER ON IF ¬LISTNG)
TLON TBITS2,MACIN ;IN A MACRO NOW
MOVEM PNT,IPLINE ;CAN GET CURRENT LINE LOC FROM HERE
SKIPE SWCPRS ; NO LISTING WHEN IN COND. PARSER
TRZ TBITS2,NOLIST ;ASSUME LISTING
TLNN TBITS2,MACEXP ;IF MACRO EXPANSION SHOULD NOT BE LISTED,
TRO TBITS2,NOLIST ; INDICATE IT
MOVEM TBITS2,SCNWRD ;UPDATE IN CORE
POPJ P, ; RETURN
DSCR -- CONTXT
DES CONTXT is used to switch the input pointers before a macro call or
prior to each invocation of the body of conditional compilation WHILEC,
CASEC, FORC, or FORLC statement. If conditional compilation is the case
then this is virtually all that need be done for the reinvocation of the
body and thus it is clearly cheaper than calling the macro in the old
sense several times with different variables (this statement is only true
for the WHILEC, FORC, and FORLC statement since the body of a CASEC
statement is only scanned once).
PAR LPSA contains the semantics of the macro name or macro pseudonym in the
case of a conditional compilation WHILEC, CASEC, FORC, or FORLC statement.
RES PNEXTC, PNEXTC-1, PLINE, and PLINE-1 are set.
⊗
↑CONTXT: HLRZ LPSA,%TLINK(LPSA) ;SEMANTICS FOR MACRO BODY
PUSHJ P,SGCOL1 ;MAKE SURE THERE'S ENOUGH ROOM
HLLZ TEMP,$PNAME(LPSA) ;STRING NUMBER -- NULL STRING
MOVEM TEMP,PNEXTC-1
MOVEM TEMP,PLINE-1
MOVEW PNEXTC,$PNAME+1(LPSA) ;SET UP NEW INPUT POINTER
MOVEM TEMP,PLINE
SETZM SAVCHR ; NOTHING SCANNED AHEAD AT THIS LEVEL
SETZM LSTCHR ; NOTHING SCANNED AHEAD AT THIS LEVEL
POPJ P, ; RETURN
DSCR STRNG, etc.
DES Input a string constant. Check all identifiers to see if
they are formal parameters to a DEFINE (macro). If so,
replace them by their internal identifiers (delete <177>
followed by unique code). Store string constant in string
space, place entry in table, results to HPNT and NEWSYM.
SEE Comments on following page for details of actual param thing.
⊗
STRNG:
PUSHJ P,INSET ;CLEAR AND RESET AS ABOVE
TLZ FF,PRMXXX ;IF " WAS FIRST CHAR, NOT IN SPECIAL MODE
STSCAN:
ILDB B,PNEXTC ;PRESERVE NEXT CHARACTER
BAKSTR: SKIPGE A,SCNTBL(B) ;DO SPECIAL THINGS
PUSHJ P,CSPEC ;IF REQUIRED
BAKST1: TLNN A,LETDG ;THINK HARD ONLY ON QUOTE, LETTDIG
JRST MORSTR ; NOT LETTER OR DIGIT
TLNE FF,DEFLUK ; SCANNING A MACRO BODY?
TLNE FF,PRMSCN ; YES, SCANNING MACRO PARAMETERS
JRST MORSTR ; YES, CHECK DELIMITERS
SKIPN REQDLM ; SPECIAL DELIMITER MODE?
JRST DEFCHK ; NO, THINK HARD
CAMN B,CURMED ; MACRO BODY END DELIMITER?
JRST LTDEND ; YES, CHECK IF DONE
CAMN B,CURMBG ; MACRO BODY BEGIN DELIMITER?
AOS BNSTCN ; YES, INCREMENT NEST COUNT
JRST DEFCHK ; THINK HARD
LTDEND: SOSL BNSTCN ; DECREMENT NEST COUNT AND CHECK IF DONE
JRST DEFCHK ; THINK HARD
JRST LTDCON ; TERMINATE MACRO BODY SCAN
MORSTR: TLNN FF,PRMXXX ;IN SPECIAL PARAMETER-SCANNING MODE?
JRST MORST1 ; NO, CONTINUE
CAIE B,"," ;END OF PARAMETER?
CAIN B,")"
JRST ENDSTR ; YES
JRST DEPOSIT ;LET SINGLE QUOTES THRU IN THIS MODE
MORST1: SKIPN DLMSTG ; A SPECIALLY DELIMITED STRING?
JRST MORST2 ; NO, GO CHECK FOR QUOTES
CAMN B,CURMED ; MACRO BODY END DELIMITER?
JRST MBDEND ; YES
CAMN B,CURMBG ; MACRO BEGIN DELIMITER?
AOS BNSTCN ; YES, INCREMENT NEST COUNT
JRST DEPOSIT ; DEPOSIT
MBDEND: SOSL BNSTCN ; DECREMENT NEST COUNT AND CHECK IF DONE
JRST DEPOSIT ; DEPOSIT
LTDCON: LSTDPB ; PUT IT AWAY
ILDB B,PNEXTC ; GET NEXT CHAR. TO KEEP IN SYNCH.
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,(A) ;DO IT
JRST ENDSTR ; GO TO END
MORST2: TLNN A,QUOTE ;END OR DOUBLE-QUOTE ?
JRST DEPOSIT ; NO, PUT IT AWAY
LSTDPB ;PUT IT AWAY
ILDB B,PNEXTC ;TRY NEXT
SKIPGE A,SCNTBL(B) ; DO THE USUAL IF SPCL
PUSHJ P,CSPEC
TLNN A,QUOTE ;IS IT ONE?
JRST[SKIPE BAKDLM ; YES, CHECK IF NEED TO RESTORE DLMSTG
SETOM DLMSTG ; YES
SETZM BAKDLM ; TURN OFF BAKDLM
JRST ENDSTR] ; DONE
DEPOSIT:
LSTDPB ;TO LISTING FILE IF REQD
DEPO1: IDPB B,TOPBYTE(USER) ;STORE CHARACTER AS IS
AOJA C,STSCAN ;LOOP ON RANDOM CHARACTERS
COMMENT ⊗
We come here if a letter or number has been seen. If we are not
scanning a macro body, we simply scan the rest of the characters
which could be an identifier into the string constant, and return
to the main string constant scanning loop.
If we are scanning a macro body, this may be a parameter name.
The following algorithm is used:
1. If not a letter, continue as if were not scanning macro body.
2. Save a pointer to the start of this ident in the string const.
3. Scan this (possible) param into the constant, no case conversion.
4. Reset the TOPBYTE pointer, save status, then return PNEXTC to
point to this ident again. Call DSCAN (ident scanner) to con-
vert and lookup this identifier (some special bits set to avoid
stacking results, etc.)
5. If not a DEFINE parameter, reset TOPBYTE and PNAME pointers to
their state at the end of step 3, clear space used during DSCAN,
and return to main string constant loop.
6. Back TOPBYTE pointer up to beginning of ident again, insert '177
(param marker), followed by param number into string, clear space
used during steps 3 and 4, update PNAME count properly, and return
to main loop.
During the course of this operation, several things get stored
(as strings) on the SP stack, to prevent damage over possible
garbage collects: the string constant so far, pointers to the
beginning and one past the end of the possible parameter, and
the input (PNEXTC) pointers (in case they represent a macro
body, which of course must be collected properly. There exists
a problem. If STRINGC happens, all these pointers must be
moved together, so that they still point inside the same string.
STRINGC, remember, when working for SAIL, adjusts each new
string to the start of a new word--catastrophic in this case.
To solve this, we convince each pointer saved that it is a
(non-null) string which is a substring of a string which is
guaranteed to contain all the others. Since in some cases we
save a pointer one past the last real char scanned, there are
places in the code below where the string count of PNAME (and
saved representations) is incremented to include this char.
This is also the reason for the one character long invented
strings ([XWD 40,1] constructs). In one mystical case, below,
a PNAME, PNAME+1 pair is saved solely for the reason that it
is the only string containing all others -- it is thrown away
after the last possible STRINGC, and the count re-computed
from other data.
Be warned that the current setup is the result of several killed
bugs -- each thought to be the last. No guarantees are
proferred that no more exist, but chances are better than ever.
⊗
DEFCHK:
HRRM C,PNAME ;MAKE COUNT HONEST BEFORE SAVING
TLNE A,NUMB ;MUST BE A LETTER
JRST DEPOSIT ; DIGIT OR OTHER NUMBER PART, GO ON
EXCH SP,STPSAV ;SAVE PNAME
MOVSS POVTAB+6 ;SET PDLOV FOR STRING STACK
AOS PNAME ;INCREMENT TO INCLUDE 1ST IDENT CHAR(SEE ABOVE)
ADDI C,1 ;TO CARRY XTRA CHAR THROUGH FURTHER STEPS
PUSH SP,PNAME ; BECAUSE DSCAN IS GOING TO CHANGE
PUSH SP,PNAME+1 ; IT
PUSH SP,[XWD 40,1] ;PROTECT 1ST CHAR PTR OVER GC (SEE ABOVE)
PUSH SP,TOPBYTE(USER);SAVE LOC OF BEGINNING OF IDENT
EXCH SP,STPSAV ;PUT BACK FOR NONCE
MOVSS POVTAB+6 ;RE-ENABLE TRAP FOR PARSE STACKS
RANSCN: ADDI C,1 ;COUNT FIRST CHAR
LSTDPB ;LIST IF NECESSARY
RANSC1: IDPB B,TOPBYTE(USER) ;KNOW FIRST ONE IS OK
ILDB B,PNEXTC
SKIPGE A,SCNTBL(B) ;USUAL TEST
PUSHJ P,CSPEC
TLNN A,LETDG
JRST SEEPRM ; NOT A LETTER OR DIGIT
SKIPN REQDLM ; SPECIAL DELIMITER MODE?
JRST CHKCON ; NO
CAMN B,CURMED ; MACRO BODY END DELIMITER?
JRST MBEDCK ; YES
CAMN B,CURMBG ; MACRO BODY BEGIN DELIMITER?
AOS BNSTCN ; YES, INCREMENT NEST COUNT
JRST CHKCON ; CONTINUE ID SCAN
MBEDCK: SOSL BNSTCN ; DONE WITH MACRO BODY?
CHKCON: AOJA C,RANSC1-1(TBITS2) ; COUNT AND LOOP
; NOW CONVERT IDENT TO UPPER CASE, ALIGN, CALL SCANNER TO LOOK IT UP
SEEPRM: HRRM C,PNAME ;UPDATE CHAR COUNT IN STRING DSCRPTR
SUBI C,1 ; MAINTAIN XTRA CHAR IN PNAME
PUSH P,A ;SAVE BITS AND
PUSH P,B ; CHAR AND
PUSH P,C ; COUNT
EXCH SP,STPSAV ;GET STRING STACK BACK
MOVSS POVTAB+6 ;ENABLE FOR STRING STACK OV
PUSH SP,[XWD 40,1] ;PROTECT PTR OVER STRINGC(SEE ABOVE)
PUSH SP,TOPBYTE(USER) ;END OF ID
PUSH SP,PNEXTC-1 ;CURRENT INPUT POSITION
PUSH SP,PNEXTC
HRRZ TBITS,-7(SP) ;ORIGINAL COUNT
PUSH SP,PNAME ;THIS IS ONLY STRING GUARANTEED
PUSH SP,PNAME+1 ; TO CONTAIN ALL OTHERS
EXCH SP,STPSAV
MOVSS POVTAB+6 ;ENABLE FOR PARSE STACK OV
SUBM C,TBITS ;LENGTH OF ID (`C' NOW CORRECT, SEE ABOVE)
ADDI TBITS,5 ;WILL MOVE OUT TO AVOID A PROBLEM
COLNEC: PUSHJ P,SGCOL2 ;COLLECT IF NECESSARY
AOS TOPBYTE(USER) ;IDPB-ILDB GETS INTO LOOP IN DSCAN IF NOT
MOVE TEMP,STPSAV ;NOW GET →BEGINNING OF ID (PERHAPS LOWER CASE)
MOVE TEMP,-6(TEMP) ;ILDB GETS ID'S FIRST CHAR
ILDB B,TEMP ;SET UP FOR SCANNER
MOVEM TEMP,PNEXTC ;SCAN FROM HERE FOR A WHILE
MOVE A,SCNTBL(B) ;GET THE BITS BACK
TLO TBITS2,LOKPRM
TRON TBITS2,NOLIST ;TURN OFF LISTING FOR RESCAN
TLO TBITS2,BACKON ;SAY YOU'VE DONE IT IF STATE CHANGED
MOVEM TBITS2,SCNWRD ;UPDATE
SCNPRM: PUSHJ P,DSCAN ;ID SCANNER -- SCAN AND LOOK IT UP
;THIS MAY CALL STRINGC -- BUT ALL-ENCOMPASSING
;PNAME ENTRY IS IN THE SP STACK, SO OK
POP P,C ;GET COUNT BACK (IT'S CORRECT)
POP P,B ;GET ID BREAK CHAR BACK
POP P,A ;GET ID BREAK CHAR BITS BACK
EXCH SP,STPSAV ;PUT THE SCANNER LOCATION BACK
SUB SP,X22 ;REMOVE ENCOMPASSING PNAME ENTRY (SEE DESCR)
POP SP,PNEXTC
POP SP,PNEXTC-1
TSTPRM: SKIPG LPSA,NEWSYM ;THESE TESTS DETERMINE IF
JRST NOPAR ; (1) THERE IS A SYMBOL OF THIS NAME
SKIPGE TBITS,$TBITS(LPSA)
JRST NOPAR ; (2) IT IS NOT A RESERVED WORD
TLNE TBITS,FORMAL
TLNN TBITS,DEFINE
JRST NOPAR ; (3) IT IS A MACRO PARAMETER NAME
MOVE TEMP,-2(SP) ;IN OTHER WORDS, WE FOUND A PARAM
MOVEI C,0 ; BP OF START OF ID IN TEMP
LINLUP: TLNN TEMP,760000 ;ZERO REST OF FIRST WORD TO BE AFFECTED
JRST OKL
IDPB C,TEMP
JRST LINLUP
OKL: HRLI TEMP,1(TEMP) ;ZERO REST OF ORIGINAL SCAN, ALL OF DSCAN
HRRI TEMP,2(TEMP) ; SCAN
SETZM -1(TEMP)
BLT TEMP,@TOPBYTE(USER)
SUB SP,X44 ;REMOVE →FIRST, →LAST OF ORIG ID SCAN
MOVE C,2(SP) ;→FIRST, WILL BECOME TOPBYTE
MOVEI TEMP,177 ;MARK PARAM OCCURRENCE
IDPB TEMP,C
SETPRM: HRRZ TEMP,$VAL(LPSA) ;PARAM NUMBER
IDPB TEMP,C
MOVEM C,TOPBYTE(USER) ;WHAT DID I TELL YOU?
HRRZ C,-1(SP) ;ORIGINAL LENGTH (+1)
AOJA C,DN ; +2 FOR MARKER, -1 TO REMOVE XTRA CHR
NOPAR: AOS TEMP,PNAME+1 ;CLEAR FROM END OF ORIGINAL SCAN
HRLI TEMP,-1(TEMP) ;TO END OF DSCAN SCAN
SETZM -1(TEMP)
BLT TEMP,@TOPBYTE(USER)
POP SP,TOPBYTE(USER);SAVE ORIGINAL SCAN
SUB SP,X33 ;FORGET OTHER POINTER
; C IS THE VALUE PRIOR TO THE DSCAN IF NOPAR
DN: TLZE TBITS2,BACKON ;TURN LISTING BACK ON?
TRZ TBITS2,NOLIST ;YES
POP SP,PNAME+1 ;NOW RESTORE THESE
POP SP,PNAME
EXCH SP,STPSAV ;ONE MORE TIME
HRRM C,PNAME ;MAKE SURE COUNT IS REALLY HONEST
;A AND B ARE THE APPROPRIATE VALUES FOR THE ORIGINAL BREAK CHAR
TLZ TBITS2,LOKPRM ;LOOK NO MORE
JRST MORSTR ;CONTINUE THE SCAN
Comment ⊗
End of string constant -- set up results for stacking,
go do it ⊗
ENDSTR:
MOVEM TBITS2,SCNWRD ;PUT ALL THE BITS AWAY
LSTDPB ;PUT "," OR ")" AWAY
TLZ FF,PRMXXX
CAIE B,12 ;LF IS SPECIAL PROBLEM!
MOVEM B,SAVCHR ;SAVE BITS FOR NEXT TIME
MOVEM B,LSTCHR ;ALSO HERE ANY TIME
TLNN FF,PRMSCN ; SCANNING ACTUAL PARAMETERS?
JRST NOMACW ; NO, MACRO BODY ENDING SUPPLIED BY ENDMAC
ADDI C,2
MOVEI TEMP,177 ;177-0 AT END
IDPB TEMP,TOPBYTE(USER)
MOVEI TEMP,0
IDPB TEMP,TOPBYTE(USER)
NOMACW:
PUSHJ P,UPDCNT ;UPDATE PNAME CNT, REMCHR, COLLECT IF NECC.
MKSTRG: MOVE LPSA,STRCON ;LOOK IT
PUSHJ P,SHASH ; UP
MOVEW HSPNT,HPNT ;SAVE FOR REMOVAL IF PRE-STATEMENT COMMENT
TLNN FF,DEFLUK ;FORCE AN ENTERS IF SCANNING FORMAL DEFINE
SKIPE DLMSTG ; FORCE ENTERS FOR ALL SPECIALLY DELIMITED
; STRINGS SO THAT THEY CAN BE DELETED IF
; NOT NEEDED (I.E. FALSE CASEC)
JRST ENTSTG ; PARAMETERS OR MACRO BODY
SKIPE LPSA,NEWSYM ;ALSO ENTER IF IT WASN'T THERE BEFORE
JRST STKSTG
ENTSTG: PUSH P,BITS ;SAVE THESE
MOVE B,[XWD CNST,STRING] ;STRING CONSTANT
MOVEM B,BITS
PUSHJ P,ENTERS ;ENTERS IT
POP P,BITS ;NO EFFECT ON OUTSIDE WORLD
STKSTG: MOVE LPSA,NEWSYM ;FOR STACKER
MOVE A,%STCON ;ALSO FOR STACKER
JRST STACK ;GO STACK RESULTS
DSCR SCNUMB -- number scanner
DES Scan a number -- keep both REAL (floaging) and fixed
representations around, use the appropriate one at the end.
A number is composed of integers and various special characters.
See the syntax for a better definition, but here is a summary:
<int><.<int>><@<+|->int>
Common sense should indicate that some of these things must
be present to constitute a legal number. The results
are returned as described on the opening page of SCAN.
⊗
SCNUMB:
; @ CHARACTER TO BE TREATED AS DELIMITER IF INSIDE START_CODE
; BLOCK
TLNE A,ATSIGN ;SHOULD WE WORRY?
TLNN TBITS2,INLIN ;IS IT SPECIAL?
JRST SCNM1 ; NO
MOVE A,%ATS ;GET BITS FOR AT SIGN DELIMITER
JRST CHAROUT ;HANDLE AS DELIMITER
SCNM1:
SETZM SCNVAL ;NUMERIC VALUE
SETZM DBLVAL ;FUTURE USE BY DBLPRC, COMPLEX
SETZB SBITS2,FLTVAL ;SBITS2 HOLDS FLAGS, FLTVAL COLLECTS REAL
; REPRESENTATION
;C HOLDS COUNT OF DECIMAL PLACES
TLNN A,QUOCTE ;OCTAL QUOTE MARK (') ?
JRST DECIM ;NO, DECIMAL NUMBER
OCTL: ILDB B,PNEXTC ;GET BACK IN SYNCH
SKIPGE A,SCNTBL(B)
PUSHJ P,(A) ;USUAL SPECIAL TREATMENT
LSTDPB
SKIPA D,[LSH TEMP,3] ;OCTAL NUMBER GATHERER
DECIM: MOVE D,[IMULI TEMP,=10] ;DECIMAL NUMBER GATHERER
PUSHJ P,GETINT ;CLEAR COUNT, GET AN INTEGER
TLNN A,LETDG ;IF NOT PART OF A NUMBER,
JRST ENDNUM ; DONE
TLNN A,DOT ;"."?
JRST NODOT ; NO DECIMAL PART, CHECK EXP PART
TRO SBITS2,FLOTNG ;MARK REAL NUMBER
PUSHJ P,LGETINT ;TRY FOR SOME MORE INTEGER
TLNN A,LETDG ;IF NOT NUMBER, NONE, JUST WANTED TO IND
JRST ENDNUM ; ICATE REAL (OR DONE)
NODOT: TLNN A,ATSIGN ;IF NOT ".", MUST BE "@"
ERR <ILLEGAL REAL CONSTANT>,1
TRON SBITS2,FLOTNG ;NO DEC PLACES UNLESS
MOVEI C,0 ; ALREADY REAL
PUSH P,FLTVAL ;SAVE FLOATING REPRESENTATION
PUSH P,C ;AND DECIMAL COUNT
SETZM SCNVAL ;CLEAR VALUES AGAIN
SETZM FLTVAL
ILDB B,PNEXTC ;CHECK SIGNED EXPONENT
SKIPGE A,SCNTBL(B) ;USUAL
PUSHJ P,(A)
LSTDPB ;PUT IT TO LISTING FILE
PUSH P,[FIXAT]
CAIN B,"-" ;MINUS?
TLOA SBITS2,EXPNEG ; YES, EXPONENT NEGATIVE
CAIN B,"+" ;NO, PLUS?
JRST LGETINT ; PLUS OR MINUS, GET DIGIT
JRST GETINT ; HAVE DIGIT, GO GET NUMBER
FIXAT: TLNE SBITS2,EXPNEG ;NEGATIVE EXPONENT?
MOVNS SCNVAL ; YES
POP P,C ;GET DECIMALS BACK
POP P,FLTVAL ;AND OLD FLOATING VALUE
ADD C,SCNVAL ;TOTAL EXPONENT
ENDNUM: CAIE B,12 ;EXCEPT FOR LINE FEED,
MOVEM B,SAVCHR ;SAVE FOR NEXT SCAN
MOVEM B,LSTCHR ;ALSO HERE ANY TIME
TLNE A,LETDG ;MUST NOT BE LEETTER OR DIG OR
ERR <ILLEGAL CONSTANT>,1
TRNN SBITS2,FLOTNG ;REAL OR INTEGER?
JRST INTEG
TLNE SBITS2,REALOV ;FLOATING POINT OVERFLOW?
ERR <REAL CONSTANT TOO LARGE>,1
MOVE A,[FDVR TEMP,[10.0]] ;ADJUST NUMBER
SKIPL C
MOVE A,[FMPR TEMP,[10.0]] ; BY MULTIPLYING OR
MOVMS C ;DIVIDING UNTIL C GOES NEGATIVE
MOVE TEMP,FLTVAL ;UNADJUSTED NUMBER
JFCL 17,MLP ;CLEAR FLAGS
JRST MLP
MULUP:
XCT A ;ADJUST
JFOV [ERR <REAL CONSTANT TOO LARGE OR TOO SMALL>,1
JRST MLP]
MLP: SOJGE C,MULUP ;KEEP GOING MAYBE
DUN: MOVEM TEMP,SCNVAL ;THIS IS THE (REAL) ANSWER
JRST NUMRET ;GO STACK
INTEG: SKIPN C ;MAKE SURE THERE WAS SOMETHING
ERR <ILLEGAL INTEGER CONSTANT>,1
TLNE SBITS2,INTOV ;INTEGER OVERFLOW?
ERR <INTEGER CONSTANT TOO LARGE>,1
TRO SBITS2,INTEGR ;MARK TYPE
NUMRET: HRLI SBITS2,CNST ;MAKE INTO TBITS WORD
PUSH P,BITS ;DON'T EFFECT OUTSIDE WORLD
MOVEM SBITS2,BITS ;SET UP FOR ENTER
PUSHJ P,NHASH ;LOOK UP THE NUMBER
SKIPE DLMSTG ; SPECIAL DELIMITER MODE?
JRST ENTNUM ; ENTER ALL NUMBERS APPEARING IN SPECIALLY
; DELIMITED STRINGS SO THAT THEY CAN BE
; DELETED WHEN DONE SANNING THE STRING
TLNN FF,DEFLUK ; COMPILE TIME ASSIGNMENT? (I.E. MACRO BODY)
SKIPG NEWSYM ;WAS IT THERE ALREADY?
ENTNUM: PUSHJ P,ENTERS ; NO, BUT IT IS NOW
POP P,BITS ;GET OLD BITS BACK
MOVE LPSA,NEWSYM ;SET UP FOR STACKING
MOVE A,%NUMCON
JRST STACK ;GO DO IT
Comment ⊗
Get an integer (base 10 only for the present).
⊗
LGETINT: ;GET A CHARACTER FIRST
ILDB B,PNEXTC
MGETINT: ;GET BITS FIRST
SKIPGE A,SCNTBL(B)
PUSHJ P,(A) ;SIGH!
LSTDPB
GETINT: ;GET AN INTEGER
TDZA C,C ;SET # DECIMAL PLACES TO 0
IDPB B,LPNT ;PUT AWAY
GETLUP: TLNN A,DIG ;IS IT A DIG?
POPJ P, ; NO, RETURN
MOVEI TEMP,-"0"(A) ;MAKE AN INTEGER
EXCH TEMP,SCNVAL ;PREVIOUS VALUE SO FAR
JFCL 17,.+1 ;CLEAR APR FLAGS
XCT D ;COLLECT NUMBER
ADDM TEMP,SCNVAL ;NEW NUMBER
JOV [TLO SBITS2,INTOV
JRST .+1] ;CHECK AND RECORD OVERFLOW
MOVEI TEMP,-"0"(A) ;MAKE A FLOATING ONE
FSC TEMP,233 ;FLOAT THIS DIG
EXCH TEMP,FLTVAL
FMPR TEMP,[10.0]
FADRM TEMP,FLTVAL ;NEW NUMBER
JFOV [TLO SBITS2,REALOV
JRST .+1] ;CHECK REAL OVERFLOW
SUBI C,1 ;COUNT DECIMAL PLACES
ILDB B,PNEXTC ; GET ANOTHER
SKIPGE A,SCNTBL(B) ;COULD IT STILL BE A DIGIT?
PUSHJ P,(A)
JRST GETLUP-1(TBITS2);LOOP
Comment ⊗ Print the last character, then stack the result
⊗
LSTACK: LSTDPB
JRST STACK
Comment ⊗ We have been backed up by the wonderful error routines
in the parser. So now we return things to their normal states:
⊗
GOAGAIN: MOVE LPSA,SAVSEM
SKIPA A,SAVPAR
DSCR CHAROUT -- returns value for single char operator.
DES No Semantic stack entry is necessary (a null pointer
is stacked). The indirect, address, and index fields
of the character comprise its PL-ID.
⊗
CHAROUT:
MOVEI LPSA,0 ;SEMANTICS RETURNED ARE NULL
DSCR STACK
DES All SCANNER sub-sections return here to place Parse
token on parse stack (PPDL) and Semantics on EXEC stack
(GPDL). STACK is bypassed only by the string constant
scanner when calling SCANNER recursively to modify for-
mal parameters.
⊗
STACK: HRRZS LPSA ;MAKE SURE ONLY RH
TLZ A,777740 ;CLEAR SCANNER BITS
PUSH SP,A ;PL ENTRY
EXCH SP,GPSAV ;GET GP POINTER
PUSH SP,LPSA ;SEMANTIC ENTRY
EXCH SP,GPSAV ;PUT AWAY SEMANTIC POINTER
MOVEM SP,PPSAV ;PUT AWAY PARSE POINTER
POPJ P,
DSCR INSET
DES prepare for ID or STRING constant scan
RES sets up TOPBYTE, REMCHR, PNAME, TOPSTR, C (char count)
SID Uses TEMP
⊗
INSET: MOVEI C,0 ;CLEAR CHARACTER COUNT
;;#GI# DCS 2-5-72 REMOVE TOPSTR
MOVSI TEMP,40 ; MOST HARMLESS ¬CONST BIT
;;#GI
MOVEM TEMP,PNAME ;FIRST PNAME DESCRIPTOR WORD
HLL TEMP,TOPBYTE(USER) ;ADJUST REMCHR FOR
HRRI TEMP,[BYTE (7) 0,4,3,2,1,0] ;CHARACTERS SKIPPED
ILDB TEMP,TEMP
ADDM TEMP,REMCHR(USER) ;UPDATE REMCHR
SKIPL TEMP,TOPBYTE(USER) ;ADJUST TOPBYTE TO
ADDI TEMP,1 ; WORD BDRY (440700 OK ALREADY)
HRLI TEMP,440700 ;[POINT 7,WORD]
MOVEM TEMP,PNAME+1 ;BP FOR THIS STRING
MOVEM TEMP,TOPBYTE(USER) ;ADJUSTED TOPBYTE
;NOW GC CAN GO AHEAD AND HAPPEN
POPJ P, ;ALL SET
SUBTTL SCANNER I/O, MACRO EXPANSION
DSCR CSPEC, SEOL, SEOM, SEOB -- Special handling routines
PAR A contains address of appropriate routine. Many SCANNER
state variables are perused and changed.
RES PNEXTC, SAVCHR, and friends are set to proper values after
more file has been read, macro has been returned from, etc.
DES Called by SCANNER routines when an input char is detected
whose SCNTBL entry indicates special conditions. The routine
address is in the right half of this SCNTBL word.
CSPEC is sometimes called to save the char count (C) before dis-
patching to the special routine (for STRINGC integrity)
SEOL is called when the SCANNER is reading from the input file
or a macro and an end of of line condition is detected. A
new line is found and the PNEXTC pointer is reinitialized.
EOM is called when the SCANNER is reading a DEFINE body, and end
of text (177 char) is seen. If the character following the EOT
is non-zero, it indicates the right actual parameter to expand
here. If it is 0, it signals end of macro. Old input values are
restored, things like PNEXTC and SAVCHR.
SEOB is called when a 0 is detected while scanning. This can mean
two things -- a TECO-type file is being read, and a buffer has
ended in the middle of a line, or the string scanner has called
SCANNER recursively to pick up a possible formal param. In either
case the right thing happens.
SEE ADVBUF routine, which these call for for file input
⊗
ZERODATA (SCANNER INPUT/OUTPUT VARIABLES)
;LINNUM -- physical line number of this output line. Used
; to force page ejects and new sub-numbering when too
; many have gone out since last logical page encountered
↓LINNUM: 0
↓LNCREF: 0 ;IF ON, CREF INFO HAS GONE OUT FOR THIS LINE
COMMENT ⊗
LPNT -- byte pointer used to deposit characters in output
buffer (LSTBUF) -- SEOL code transfers this data, along
with CREF data, to the output file buffers. IDPB B,LPNT
instructions are scattered throughout the SCANNER to build
this output file
⊗
↑↑LPNT: 0
↑↑LSTBUF: 0 ;ADDRESS OF LISTING BUFFER
;LSTCHR -- saved scan-ahead character -- sometimes slightly different
; from SAVCHR -- used for error message (the arrow) output
↑↑LSTCHR: 0
ENDDATA
SUBTTL Cspec, Seol
; CALL SPECIAL ROUTINE, BUT FIRST MAKE SURE CHARACTER COUNT IS
; CORRECT IN "PNAME" (THE DESCRIPTOR FOR THE CURRENTLY DEVELOPING
; IDENTIFIER OR STRING)
CSPEC: HRRM C,PNAME ;UPDATE CHAR COUNT
JRST (A) ;DISPATCH TO SPECIFIED ROUTINE
SEOL:
PUSH P,C ;SAVE CHARACTER COUNT (CLOBBERED BY HDROV)
TRNE TBITS2,NOLIST ;ARE WE LISTING NOW?
JRST NOLST ; NO
; TIME TO DO A LISTING
MOVE TBITS,LPNT ;PUT THE LINE FEED IN LIST BUFFER
LLL2: IDPB B,TBITS
MOVEI B,0 ;ZERO REMAINING CHARS OF CURRENT WORD
TLNE TBITS,760000 ;ALL DONE?
JRST LLL2 ;NO, PUT OUT ZERO
MOVEM TBITS,LPNT ;SAVE AGAIN FOR A WHILE
;IF CREFING WAS DONE ON THIS LINE, TERMINATE THE CREF STUFF
SKIPN LNCREF ;CREF GONE OUT?
JRST NOLNX ;NOPE
SETZM LNCREF ;RESET.
MOVEI TBITS,177 ;DELETE
PUSHJ P,CHROUT
MOVEI TBITS,"A" ;AND AN A
PUSHJ P,CHROUT
NOLNX:
; IF PCNT OUTPUT DESIRED, DO THAT FIRST
TLNN TBITS2,PCOUT ;WANT TO PRINT PC?
JRST NOPC ; NO
MOVE TBITS,PCNT ;YET ANOTHER FRNP
ADD TBITS,LSTSTRT ;OFFSET BY USER-PROVIDED LOC
MOVEI B,CHROUT ;ROUTINE TO USE
MOVEI PNT2,6 ;ALWAYS DO 6 CHARS
PUSHJ P,[
↑FRNP1: SKIPA TEMP,[10]
↑FRNPD: MOVEI TEMP,=10
FRNP3: IDIV TBITS,TEMP
IORI SBITS,"0"
HRLM SBITS,(P)
SOJE PNT2,FRNP2
PUSHJ P,FRNP3
FRNP2: HLRZ TBITS,(P)
JRST (B) ;CHARACTER TO OUTPUT
]
MOVE SBITS,[POINT 7,[ASCII / /]]
PUSHJ P,LL1+1 ;SEE BELOW
; IF LINE NUMBER OUTPUT DESIRED, DO IT NEXT.
NOPC: MOVE SBITS,[POINT 7,ASCLIN] ;ASSUME WANT LINE NUMBER
TLNE TBITS2,LINESO ;IS IT THE CASE
PUSHJ P,[LL1: PUSHJ P,CHROUT ;CHARACTER TO OUTPUT
ILDB TBITS,SBITS ;NEXT CHAR
JUMPN TBITS,LL1
POPJ P,]+1 ;KLUDGE........
; NEXT LINE UP THE BP FOR SOME RAPID-FIRE STUFF
NLNO: MOVE TBITS,LSTPNT ;LST OUTPUT BYTE POINTER
MOVE SBITS,LSTCNT ;IF ALREADY LINED UP....
HARRY: TLNN TBITS,760000 ;LINED UP WHEN PTR PART IS 01
JRST LNDUP
SOS SBITS,LSTCNT ;DENOTE CHANGE
IBP TBITS ;MAINLY WANT TO ADJUST COUNT
JRST HARRY ;COULD PROBABLY DO CALCULATION
LNDUP: MOVEM TBITS,LSTPNT ;UPDATE
IDIVI SBITS,5 ;#WORDS LEFT, NO REMAINDER GUARANTEED
AOS PNT2,LPNT ;WE GOT THIS FAR
HRRZS PNT2
SUB PNT2,LSTBUF ;HOW MANY WORDS?
CAMGE SBITS,PNT2 ;IS THERE ROOM?
PUSHJ P,LSTDO ; NOW THERE IS
MOVNI SBITS,5 ;UPDATE CHAR COUNT
IMUL SBITS,PNT2
ADDM SBITS,LSTCNT
EXCH PNT2,LSTPNT ;AND LSTPNT
ADDM PNT2,LSTPNT ;PREV VERSION IN PNT2
ADDI PNT2,1
HRL PNT2,LSTBUF ;BLT WORD (LSTBUF,,OUTBUF)
BLT PNT2,@LSTPNT ;WRITE THE LINE!
HRRO TEMP,LSTBUF ;ADDR OF FIRST WORD OF BUFFER
SUB TEMP,[XWD 677077,1] ;POINT 5,@LSTBUF,29
MOVEM TEMP,LPNT ;NEW LIST POINTER
MOVE TEMP,[ASCID / /] ;BLANKS IN CASE
MOVEM TEMP,ASCLIN ;IN MACRO AND MORE LINES TO COME
AOS TBITS,LINNUM ;CHECK LINE OVERFLOW
IDIVI TBITS,PGSIZ
SKIPN SBITS
PUSHJ P,HDROV ;PRINT FF
; ENOUGH OUTPUT, NOW FOR SOME INPUT
NOLST:
SKIPE SRCDLY ;SWITCHING SOURCE INPUT?
JRST NXTSRC ; YES
MOVE PNT,PNEXTC
IBP PNT
MOVEM PNT,PLINE ;UPDATE IF MACRO
TLNE TBITS2,MACIN ;DONE IF MACRO
JRST LDO1 ;DONE
; MAKE A LINE NUMBER IN CASE FILE HAS NONE
AOS TBITS,BINLIN ;SEQUENTIAL WITHIN PAGE
MOVEI B,[IDPB TBITS,A ;ROUTINE TO DISPENSE CHARS
POPJ P,]
MOVEI PNT2,5 ;5 CHARS ALWAYS
MOVE A,[POINT 7,ASCLIN] ;PUT IT HERE
PUSHJ P,FRNPD ;GET ASCII VERSION
MOVEI TEMP,1
ORM TEMP,ASCLIN ;MAKE ASCID
; ACTUAL LINE NUMBER WILL OVERRIDE THIS IF THERE
LDB TEMP,PNT ;NEXT CHAR.
JUMPE TEMP,NULCHR ;GO FIND NON-NULL
LINCHA: MOVE TEMP,(PNT)
LINCHK: TRNN TEMP,1 ;ARE WE IN LINE NUMBER?
JRST LDUNA ;NO THIS IS THE NEXT CHAR.
CAME TEMP,[ASCID/ /];IS IT A PAGE MARK PERHAPS
AOJA PNT,LDUN ;NO JUST SKIP LINE NUM AND TAB
MOVEM PNT,PNEXTC ;HDR CLOBBERS THIS
PUSHJ P,HDR ;WRITE PAGE MARK, NEW TITLE LINE
MOVE PNT,PNEXTC ;GET HIM BACK
SKIPN 1(PNT) ;END OF BUFFER?
PUSHJ P,ADVBUF ;YES, GET NEXT.
ADDI PNT,1 ;POINT BEHIND NEXT LINE NUMBER
SKIPN TEMP,1(PNT) ;IS IT IN THIS BUFFER?
PUSHJ P,ADVBUF ;NO.
HRLI PNT,350700 ;POINT TO FIRST CHAR. OF LINE NUMBER
AOJA PNT,LINCHA ;AND DO IT AGAIN (IN CASE 2 PAGE MARKS).
NULCHR: ILDB B,PNT ;MOVE ON UP
MOVE TEMP,(PNT) ;GET COMPLETE WORD
JUMPN B,LINCHK ;FINALLY WE GOT SOMETHING
IBP PNEXTC ;KEEP IN STEP
JUMPN TEMP,NULCHR ;END OF BUFFER?
PUSHJ P,ADVBUF ;YES.
JRST NULCHR ;HERE WE GO LOOP-D-LOOP
LDUN: SKIPE (PNT) ;IS TAB IN THIS BUFFER
JRST LDUN1 ;YES
PUSHJ P,ADVBUF ;NO
IBP PNT ;MAKE IT CURRENT
LDUN1: MOVEM TEMP,ASCLIN ;CURRENT LINE#
MOVEM PNT,PNEXTC ;THIS GUY POINTS TO TAB
LDUNA: MOVE TEMP,PNEXTC ;MAY NOT USE PNT
MOVEM TEMP,PLINE ;BEGINNING OF LINE
IFN FTDEBUG,<
AOS LINCNT ;COUNT NUMBER OF LINES SEEN
SKIPL STPAGE ;ARE WE LOOKING FOR A PAGE/LINE?
PUSHJ P,STPLIN ;LINE BREAK IF NECESSARY.
>
LDO1: MOVEI B,12 ;GET LINE FEED BACK.
MOVEI A,0 ;HARMLESS LF
MOVE USER,GOGTAB
POP P,C ;RESTORE CHARACTER COUNT.
POPJ P, ;WASN'T THAT WONDERFUL
; HERE WE SAVE INFO ABOUT SOURCE FILE, AND PREPARE TO GET INFO
; ABOUT NEW ONE.
NXTSRC: MOVE A,AVLSRC ;BITS TELLING FREE CHANNELS
JFFO A,GOTNEW ;FOUND A FREE ONE
ERR <NO MORE AVAILABLE SOURCE CHANNELS>
GOTNEW:
PUSH P,B ;SAVE NEW CHANNEL #
MOVEI C,ENDSRC-SRCCDB+1 ;SIZE OF SAVE AREA
PUSHJ P,CORGET ;GET ONE
ERR <NO CORE AVAILABLE FOR FILE SWITCH>
HRR TEMP,B ;BLT WORD
HRLI TEMP,SRCCDB
BLT TEMP,ENDSRC-SRCCDB(B)
HRRZM B,SWTLNK ;SAVE PTR TO SAVE AREA
TLO TBITS2,INSWT ;WE'RE SCANNING SWITCHED-TO FILE
MOVEM TBITS2,SCNWRD
FOR II ⊂ (LSTCHR,SAVCHR,SAVTYI,EOF,EOL) <
SETZM II
>
POP P,A ;CHANNEL NUMBER
FOR II←0,1 <
DPB A,[POINT 4,SRCOP+II,12]
>
FOR II←0,3 <
DPB A,[POINT 4,INSRC+II,12]
>
NOEXPO <
DPB A,[POINT 4,SRCOP+2,12] ;PUSHJ IF EXPO
>;NOEXPO
MOVN TEMP,A ;-CHANNEL NUMBER
MOVSI LPSA,400000 ;BIT
LSH LPSA,(TEMP)
ANDCAM LPSA,AVLSRC ;THIS CHANNEL UNAVAILABLE
AOS TEMP,LININD ;HOW FAR IN TO SPACE ON TTY
CAILE TEMP,MAXIND ;TOO FAR?
SOS LININD ;NOT REALLY
SETOM TYICORE ;WILL SCAN FROM STRING
MOVE TEMP,GENLEF+2
HRROI TEMP,$PNAME+1(TEMP) ;GET STRING TO BE SCANNED
POP TEMP,PNAME+1
POP TEMP,PNAME ;PUT ER THERE
PUSHJ P,ENDSWT ;USE EOF CODE TO GET NEW FILE
;SRCDLY WILL BE TURNED OFF HERE
JRST NOLST ;AND GO BACK TO END OF LINE CODE
; END OF BUFFER CODE.
SEOB: TLNE TBITS2,LOKPRM ;END OF POSSIBLE MACRO PARAM SCAN?
POPJ P, ;YES, IGNORE THE WHOLE THING
MOVE PNT,PNEXTC ;CURRENT BP
JUMPE PNT,ADVIT ;INITIALIZATION TIME
SKIPE TEMP,(PNT) ;REAL END OF BUFFER?
JRST SEOBAK ; NO, WILL COME BACK UNTIL NOT NULL
ADVIT: PUSHJ P,ADVBUF
TRNN TEMP,1 ;LINE NUMBER? (INIT SCAN FOR SOS FILES)
JRST SEOBAK ;NO, FIND NEXT CHAR
MOVEM TEMP,ASCLIN ;SAVE LINE NUMBER
IBP PNT ;OVER TAB
ADDI PNT,1 ;BACK IN BUSINESS
SEOBAK: MOVEM PNT,PLINE ;BEGINNING OF LINE
ILDB B,PNT ;GET CHAR
MOVEM PNT,PNEXTC ;UPDATE
SKIPGE A,SCNTBL(B) ;SPECIAL?
JRST (A) ;YES, HANDLE
POPJ P, ;NO, DONE
; END OF PAGE (TECO FILES ONLY)
SEOP: PUSHJ P,HDR ;PRINT FF, TITLE LINE
MOVEI B,15 ;PRETEND A CR
MOVEI A,0 ;BITS FOR CR
POPJ P,
Comment ⊗ Parameter delimiter or end of message ⊗
EOM: ILDB B,PNEXTC ;CHECK WHICH
JUMPE B,RESTOR ;ZERO, END OF MACRO (OR PARAM) TEXT
; PARAMETER NEEDED
SETZM SAVCHR
SETZM LSTCHR
MOVE LPSA,DEFRNG
GETIT: SOJE B,GOTIT ;LOOK FOR THE PARAMETER OF PROPER NUMBER
RIGHT ,%RVARB,<[ERR <NOT ENOUGH ARGUMENTS SUPPLIED TO MACRO>]>
JRST GETIT ;KEEP LOOKING
GOTIT:
DFNEST: MOVE PNT,DEFPDP ;NOW SAVE STATE OF SCANNER AND RECUR
PUSH PNT,[-1] ;INDICATE NO DEFRNG CHANGE
PUSH PNT,PNEXTC-1
PUSH PNT,PNEXTC ;INPUT POINTER
PUSH PNT,SAVCHR ;SCANNED AHEAD
MOVEM PNT,DEFPDP ;SAVE POINTER
PUSHJ P,SGCOL1 ;MAKE SURE ENOUGH ROOM
HLLZ TEMP,$PNAME(LPSA) ;STRING NUMBER
MOVEM TEMP,PNEXTC-1
MOVEM TEMP,PLINE-1
MOVEW PNEXTC,$PNAME+1(LPSA) ;NEW INPUT POINTER
MOVEM TEMP,PLINE
MOVEI B,"⊂" ;MARKER FOR MACRO EXP
TLNE TBITS2,LSTEXP ;WANT IT?
IDPB B,LPNT ;YES
TLO TBITS2,MACIN ;MARK IN MACRO
TLNN FF,PRMSCN ; IF SCANNING ACTUALS, THEN LEAVE LISTING ALONE
TRZ TBITS2,NOLIST ;ASSUME LISTING
TLNN TBITS2,MACEXP ;EXPANDING?
TRO TBITS2,NOLIST ;NO
MOVEM TBITS2,SCNWRD ;UPDATE
TLNE FF,PRMSCN ; SCANNING PARAMETERS?
SKIPN REQDLM ; YES, IN SPECAIL DELIMITER MODE?
JRST NEWCHR ;GO GET FIRST NEW CHAR, RET
CAIN P,DSPRMS+3 ; IS 177-# FIRST ITEM IN ACTUAL PARAMETER
HRRI P,BALCHK ; YES, CHANGE RETURN ADDRESS TO REFLECT
; THAT UNTESTED COMMAS AND RIGHT PARS. WILL
; BREAK SCAN
DLMPRM: ILDB B,PNEXTC ; SCAN REST OF CHARS. INTO STRING CONSTANT
SKIPGE A,SCNTBL(B) ; SPECIAL?
PUSHJ P,(A) ; DO IT
LSTDPB ; PUT IT AWAY
IDPB B,TOPBYTE(USER) ; DEPOSIT IT
AOJA C,DLMPRM ; INCREMENT COUNT AND CONTINUE SCAN
RESTOR: MOVE PNT,DEFPDP
POP PNT,SAVCHR ;CHAR SCANNED AHEAD
POP PNT,PNEXTC ;OLD INPUT POINTER
POP PNT,PNEXTC-1 ;STRING NUMBER
ADD PNT,X22 ;START PLINE HERE
POP PNT,PLINE
POP PNT,PLINE-1
POP PNT,LPSA ;PERHAPS OLD DEFRNG
MOVEM PNT,DEFPDP
JUMPL LPSA,DDUN ;NONE OR NOT TO BE CHANGED
EXCH LPSA,DEFRNG
PUSHJ P,KILLST ;KILL DEFRNG (OLD)
DDUN: MOVEI B,"⊃" ;END OF EXPANSION MARKER
TLNE TBITS2,LSTEXP
IDPB B,LPNT ;PUT OUT IF DESIRED
SKIPN PNEXTC-1 ;OUT OF MACROS?
TLZA TBITS2,MACIN ;YES
JRST DUNRST ;NO
TLNE FF,LISTNG ;WANT LISTING, IN GENERAL?
TRZ TBITS2,NOLIST ;YES, START UP AGAIN
MOVE TEMP,IPLINE ;PLINE TO OUTER LEVEL VALUE
MOVEM TEMP,PLINE
SETZM PLINE-1
DUNRST: MOVEM TBITS2,SCNWRD ;SAFETY FIRST
; NOW GET A CHARACTER FOR THE SCANNER
TLNE FF,PRMSCN ; SCANNING PARAMETERS?
SKIPN REQDLM ; YES, IN SPECIAL DELIMITER MODE?
TRNA ; SKIP
SUB P,X11 ; POP RETURN ADDRESS, AND NOW WILL RETURN
; TO CHECK NESTING INSTEAD OF CONTINUING
; FORMAL PARAMETER SCAN
SKIPN B,SAVCHR ;HAVE IT ALREADY?
JRST NEWCHR ;NO
SETZM SAVCHR ;NO LONGER AHEAD (DCS 5-27-71)******
MOVE A,SCNTBL(B) ;YES, DON'T DISPATCH AGAIN
POPJ P,
NEWCHR: ILDB B,PNEXTC ;GET FROM INPUT
SKIPGE A,SCNTBL(B) ;SPECIAL?
JRST (A) ;YES, DISPATCH
POPJ P, ;NO, DONE
DSCR KILLST
CAL PUSHJ
PAR LPSA → first Semblk to be released
RES Unlinks Semblk from %RSTR, releases it to free
storage, then continues right down %RVARB until
all Semblks on this VARB-Ring are released.
DES THIS ROUTINE IS IN THE WRONG PLACE!
SEE FREBLK, ULINK
⊗
↑KILLST:
PUSH P,LPSA
JUMPE LPSA,KLPDUN
KLLUP:
PUSHJ P,URGSTR ;UNLINK FROM STRING RING
FREBLK
RIGHT ,%RVARB,<[KLPDUN: POP P,LPSA
POPJ P,]>
JRST KLLUP
SUBTTL SCANNER INPUT AND LISTING ROUTINES
DSCR ADVBUF -- new input buffer routine
DES Reads a new input buffer, gets a new source file
if this one is exhausted or if file switching is
happening (prints loser message if no files remain),
and assures that the buffer ends in zero for EOB
detection by SEOL. The buffers were made long enough
to allow the inclusion of an extra word of zero.
SID Saves USER, C -- reinits A,B -- all others vulnerable
SEE SEOL, SEOB, routines which detect EOB and call ADVBUF.
⊗
ADVBUF:
XCT INSRC ;ADVANCE BUFFER
XCT TSTSRC ;ANY ERRORS?
ERR <I-O ERROR ON SOURCE DEVICE>,1
XCT EOFSRC ;TO ENDFL ON EOF
JRST ENDFL
PUSHJ P,SGCHK ;STRING GC, IF NECESSARY, TBITS←SRCCNT
ADDI TBITS,4 ;(CHAR CT+4)/5 IS WORD COUNT
IDIVI TBITS,5
ADD TBITS,SRCPNT ;ADD BASE ADDRESS
IBP TBITS ;→LAST WORD+1, MAKE 0 TO
SETZM (TBITS) ; DENOTE EOB
MOVE PNT,SRCPNT ;RESET PNT TO CURRENT BP,
MOVEM PNT,PNEXTC ;FIX THIS GUY TOO.
MOVE TEMP,1(PNT) ; TEMP TO WORD NEXT REFERENCED
POPJ P,
; CHECK FOR STRING SPACE FULL, GC IF SO
SGCHK:
HRRZ TBITS,SRCCNT ;GET # OF CHARACTERS
MOVE TEMP,REMCHR(USER) ;TEST ENOUGH ROOM
ADD TEMP,TBITS
SKIPL TEMP ;IS THERE ENOUGH?
JRST SGCOL ;NO, COLLECT SPACE
POPJ P, ;NOT NECESSARY
ENDFL: XCT RELSRC ;RELEASE OLD FILE,
ENDSWT: MOVEM TBITS2,SCNWRD ;UPDATE IN CORE VERSION
PUSHJ P,FILEIN ;FIND AND INIT NEW ONE
JRST [TLNN TBITS2,EOFOK
ERR <FATAL END OF SOURCE FILE>
MOVNI B,1 ;MARK END OF FILE NEXT TIME
MOVEI A,1 ;HARMLESS, BUT BREAKS IGNORABLE
SUB P,X11 ;RETURN EARLY
POP P,C ;CHAR COUNT BACK
POPJ P,]
PUSHJ P,MAKT ;PREPARE NEW TITLE LINE
SKIPE SRCDLY ;COMING BACK FROM SWTCHED-TO FILE?
JRST SWTBKP ; YES, DO MORE BOOKKEEPING
SETZM FPAGNO ;FIRST PAGE IN NEW FILE
PUSHJ P,HDR ; , DENOTE IT
JRST ADVBUF ; OR PRINT LOSING MESSAGE, TRY AGAIN
; WE HAVE OLD SOURCE FILE BACK, FAKE ADVBUF
SWTBKP:
PUSHJ P,HDROV ;CONTINUE PAGE NUMBERING FOR FILE
SETZM SRCDLY
PUSHJ P,SGCHK ;CHECK (LIBERALLY) FOR STRING SPACE FULL
MOVE TEMP,PNEXTC ;NOW SET UP PNT, PNEXTC, AND TEMP AS
SWTLUP: SKIPN (TEMP) ; THEY WOULD BE COMING OUT OF ADVBUF
JRST ADVBUF ;WE WERE AT END OF BUFFER ANYWAY
MOVE PNT,TEMP ;WE'RE GOING TO GET AHEAD OF SELVES
ILDB TBITS,TEMP ;CHECK NULLS
JUMPE TBITS,SWTLUP ;ALL THIS UNECESSARY IF SOS FILES, BUT...
MOVEM PNT,PNEXTC ;FAKE ADVBUF
MOVE TEMP,(TEMP) ;WORD WITH NON-NULL CHAR
POPJ P,
UPDCNT: HRRM C,PNAME ;UPDATE PNAME
ADDB C,REMCHR(USER) ;AND REMCHR
CAMGE C,[-=50] ;ARE WE NEARING CATASTROPHE?
POPJ P, ; NO
;EVEN THIS CANNOT PREVENT OCCASIONAL DEATH
MOVEI TBITS,=50 ;REQUIRE AT LEAST THIS MANY
JRST SGCOL ;GO COLLECT
SGCOL1: HRRZ TBITS,$PNAME(LPSA) ;CHAR COUNT
SGCOL2: MOVE USER,GOGTAB
MOVE TEMP,REMCHR(USER) ;REMAINING CHARS
ADD TEMP,TBITS
SKIPGE TEMP ;NOT ENOUGH?
POPJ P, ;NO, OK
SGCOL: EXCH SP,STPSAV ;GET STRING STACK
PUSH P,TBITS ;PASS TO STRGC THIS WAY
PUSHJ P,STRGC ;COLLECT STRING SPACE
EXCH SP,STPSAV ;GET IT BACK
POPJ P, ; NO, GO AHEAD
↓CHROUT: SOSG LSTCNT ;ONE CHAR OUTPUT ROUTINE
PUSHJ P,LSTDO ;DO AN OUTPUT
IDPB TBITS,LSTPNT ;DO THE OUTPUT
POPJ P,
↓LSTDO: OUT LST,
POPJ P, ;OK
ERR <I-O ERROR ON LISTING DEVICE>,1
POPJ P,
DSCR --HERE IS THE CREFFINF STUFF (STRANGE PLACE N'EST CE PAS?)
DES We'll leave it at these comments for the nonce:
For those of you who are interested in what cref output looks like, allow
me to discourse for a while on it. Basically, the output line is
preceeded by a whole mess of garbage. (In the following discussion,
let ≡ stand for delete -- octal 177).
1. The first thing in a line with cref information in it must be
≡B . This is handled in crefout.
2. There are two types of symbols:
a. NUMSYM's, which are represented by a six-digit number(decimal)
which is unique to that occurrance of the symbol.
The number is represented by an octal 6 (length of symbol)
followed by the number in ASCII.
b. SYMSYM's, which are the real symbolic symbols. These consist
of one byte of length, followed by the symbol in ASCII
3. When an identifier is seen in the source text, you do one of
several things:
1 followed by the NUMSYM -- a regular identifer seen.
3 followed by the SYMSYM -- a reserved word.
5 followed by the NUMSYM -- a macro use.
-- it is occasionally to flush the last type 1 instance. This is done
by following it immediately with a 7.
4. When defining things, we put out:
1 followed by the NUMSYM followed by 2 -- ordinary identifier
6 followed by NUMSYM -- macro.
5. When beginning a block, we put out a 15 followed by the SYMSYM.
6. When ending a block, we put out a 16 followed by the SYMSYM.
Then come the equivalences of numbers and symbolic names.
7. To equivalence an ordinary symbol, we put out 11 followed by
the NUMSYM followed by the SYMSYM.
8. When all done with the cref information for a line, we put out
≡A .
⊗
BEGIN CREF
↑LCREFIT:
TDZA C,C
↑ECREFIT: MOVNI C,1 ;CREF FOR ENTER.
TLNN TBITS,CNST ;IF A CONSTANT, FORGET IT.
TLNE FF,NOCRFW ;AN EXTERNAL PROCEDURE -- DO NOT CREF;
POPJ P,
MOVE A,X11 ;ORDINARY IDENTIFIER.
TLNE TBITS,DEFINE ;IF THIS IS A MACRO.
MOVE A,[XWD 6,5]
TLNE TBITS,400000 ;RESERVED WORD?
MOVE A,X33
TLNE C,-1 ;ENTER OR LOOKUP?
MOVSS A
PUSHJ P,CREFOUT ;AND PUT OUT THE CHARACTER.
PUSHJ P,CREFSYM ;CREF THE SYMBOL IN LPSA,TBITS.
TLNN A,-2 ;IF REGULAR SYMBOL,
SKIPL C ;BEING DEFINED,
POPJ P,
MOVEI A,2 ;THEN PUT OUT EXTRA THING.
JRST CREFOUT ;....
CREFSYM: PUSH P,TBITS
JUMPL TBITS,ASC1 ;A RESERVED WORD ----
MOVEI TBITS,6
PUSHJ P,CHROUT ;NUMBER OF CHARACTERS.
MOVEI TBITS,(LPSA)
MOVEI PNT2,6 ;FOR THE RECURSIVE NUMBER PRINTER IN SEOL.
;;#MF#↓ 5-1-73 DCS (1 OF 2) AC B NEEDED IN CALLER OF LCREFIT
PUSH P,B
MOVEI B,CHROUT ;OUTPUT ROUTINE FOR SAME --
PUSHJ P,FRNP1 ; FRNP1 IS IN SEOL ABOVE.
;;#MF#↓ (2 OF 2) SAVE, RESTORE B
POP P,B
POP P,TBITS
POPJ P, ;GO AWAY.
ASC1: PUSH P,A
PUSHJ P,CREFASC ;ASCII CREF.....
POP P,A
POP P,TBITS
POPJ P,
CREFCHR: CAIN A,"_"
MOVEI A,"." ;CHANGE UNDERLINE TO .
↑↑CREFOUT: SKIPE LNCREF ;CREF GONE FOR THIS LINE?
JRST GONEF ;YES
SETOM LNCREF
PUSH P,A
MOVEI A,177
PUSHJ P,CREFOUT
MOVEI A,"B"
PUSHJ P,CREFOUT
POP P,A
GONEF: SOSG LSTCNT
PUSHJ P,LSTDO
IDPB A,LSTPNT
POPJ P,
↑↑CREFASC: ;CREF THE ASCII FOR A SYMBOL.
HRRZ A,$PNAME(LPSA) ;COUNT.
PUSHJ P,CREFOUT ;AND CREF...
MOVE TEMP,A
MOVE C,$PNAME+1(LPSA) ;BYTE POINTER.
ILDB A,C
PUSHJ P,CREFCHR
SOJG TEMP,.-2
GPOPJ: POPJ P,
↑↑CREFDEF: ;PUT OUT SYMBOL DEFINTION.
MOVEI A,11 ;ORDINARY SYMBOL
MOVE TEMP,$TBITS(LPSA)
TLNE TEMP,DEFINE
MOVEI A,13 ;FOR MACRO
PUSHJ P,CREFOUT
PUSHJ P,CREFSYM
JRST CREFASC ;CODE,SYMBOL,PRINT-NAME.
↑↑CREFBLOCK: ;END OF A BLOCK.
MOVEI A,16
PUSHJ P,CREFOUT
JRST CREFASC ;AND THE NAME.
BEND
DSCR HDR, HDROV
DES List routines for top of (physical page). Reset page,
line counters. Print a page header if listing.
HDR is called when new page (logical) is sensed.
HDROV is called when PGSIZ lines have been printed
since last time a header was printed.
SID Uses D, TEMP,USER -- saves USER, C, others vulnerable.
⊗
↑HDR:
AOS PAGENO ;NEXT PAGE, PLEASE
AOS FPAGNO ;NEXT IN THIS FILE
SETZM PAGINC ;FIRST PHYSICAL PAGE NO
SETZM BINLIN ;SEQUENTIAL LINE #
AOS BINLIN ;ALWAYS STARTS AT 1
;;#HU# 6-20-72 DCS BETTER TTY LISTING
SKIPN CRIND ;NEED CRLF/INDENT?
JRST NCRIND ;NO
SETZM CRIND
TERPRI
MOVE TEMP,LININD
OUTSTR INDTAB(TEMP) ;CRLF -- INDENT
NCRIND: PRINT < >
DECPNT FPAGNO ;JUST KEEP TRACK
↑HDROV:
SETZM LINNUM
AOS PAGINC ;HERE WHEN LINES OVERFLOW PAGE
TLNN FF,LISTNG ;ARE WE LISTING?
POPJ P, ; NO
PUSH P,D ;SAVE
MOVEI TEMP,"$"
MOVEM TEMP,BKR ;$ BREAKS ASCFIL
MOVE A,[POINT 7,TITLIN]
MOVEI TEMP,=5*28 ;MAKE SURE ENOUGH ROOM REMAINS
CAMLE TEMP,LSTCNT ;IS THERE
PUSHJ P,LSTDO ;NOW THERE IS
MOVEI D,14
IDPB D,LSTPNT
MOVE TEMP,LSTPNT
PUSHJ P,ASCFIL ;INTERSPERSE CONSTANTS
MOVE D,FPAGNO
PUSHJ P,DECFIL
MOVN D,PAGINC ; TO FORM HEADER LINE
PUSHJ P,DECFIL
PUSHJ P,ASCFIL
MOVE LPSA,TTOP
PUSHJ P,PSTRNG
PUSHJ P,ASCFIL
TLZ TEMP,770000 ;ADJUST BYTE POINTER
EXCH TEMP,LSTPNT ;TO NEW LOC
SUB TEMP,LSTPNT ;GET SIZE
IMULI TEMP,5 ;NUMBER OF CHARS USED
HRREI TEMP,-5(TEMP)
ADDM TEMP,LSTCNT
POP P,D
POPJ P,
TITLIN: BLOCK =28 ;SHOULD BE BIG ENOUGH FOR TITLE LINE
; MAKT -- PREPARE A TITLE LINE
↑MAKT:
MOVEI TEMP,"%"
MOVEM TEMP,BKR ;% BREAKS ASCFIL
MOVE A,[<POINT 7,[ASCII / SAIL %/]>]
MOVE TEMP,[POINT 7,TITLIN]
MOVEI LPSA,IPROC ;GET PROGRAM NAME
PUSHJ P,[
PSTRNG: HRRZ B,$PNAME(LPSA)
MOVE C,$PNAME+1(LPSA)
MKT1: ILDB D,C
IDPB D,TEMP
SOJG B,MKT1 ;PUT OUT PROG NAME
POPJ P, ]
PUSHJ P,ASCFIL ;MOVE IN THIS MUCH
MOVE A,[<POINT 7,[ASCII / %:% % $
$
$%/]>]
; A AND TEMP SHOULD NOT BE USED HERE UNLESS SAVED
PUSH P,A
CALL6 C,DATE
IDIVI C,=31 ;DAY IN D
ADDI D,1 ;DAY - 1 THAT IS
PUSHJ P,DECFIL
IDIVI C,=12 ;MONTH - 1 IN D
MOVE D,[ASCII /-JAN--FEB--MAR--APR--MAY--JUN--JUL-/
ASCII /-AUG--SEP--OCT--NOV--DEC-/](D)
MOVE A,[POINT 7,D]
MOVE D+1,[ASCII /%/]
PUSHJ P,ASCFIL
MOVEI D,=64(C) ;YEAR
PUSHJ P,DECFIL
POP P,A
PUSHJ P,ASCFIL ;SPACES, I THINK
CALL6 C,MSTIME ;TIME IN MS
IDIVI C,=60000
IDIVI C,=60 ;MINUTES IN D
EXCH C,D
PUSHJ P,DECFIL ;PRINT IT
PUSHJ P,ASCFIL ;COLON
MOVE D,C ;MINUTES
PUSHJ P,DECFIL ;PRINT THEM
PUSHJ P,ASCFIL ;MORE SPACES
MOVE B,SRCFIL ;GET SOURCE FILE NAME
MOVEI D,6 ;COUNT
LLUP: ROTC B,6
TRZ C,100 ;DITCH BIT
ADDI C,40 ;CONVERT TO ASCII
IDPB C,TEMP
SOJN D,LLUP
PUSHJ P,ASCFIL ;MORE SPACES AND THINGS
POPJ P,
SUBTTL ENTERS -- ENTER A SYMBOL
DSCR ENTERS -- make new symbol entry
DES Will use existing comments, not use standard form
ENTERS creates a block of proper type for this "ATOM", and
installs the proper links to assure this thing can be found
again. ENTERS can handle the following kinds of things:
1. Variables -- numeric, STRING, ITEM, etc.
2. Labels
3. Procedure identifiers
4. Numeric constants
5. String constants
STEPS:
1-3: Create a block for ID. Check that level is greater
for new symbol if old one was present (FORWARD Procedures
are a special case). Install level, $TBITS, $PNAME; link
to SYMTAB hash table (→instr to fetch right bucket in HPNT).
Link to current VARB structure via %RVARB, to STRRNG via
%RSTR for STRINGC collector. Return →Semantics in NEWSYM
(replaces → found block if redefinition).
4: Insert numeric value entry in CONST bucket. No checking
(level, etc.) is necessary because ENTERS is called for
constants only when the lookup fails. Bucket fetching instr
found in HPNT, new Semantics to NEWSYM.
5: Insert new string constant entry in STRCON bucket. #4
arguments also apply here.
PAR "BITS" -- the TBITS flags for the ATOM. These will be
installed in the entry. They also guide the entry process.
"PNAME" -- String descriptor for $PNAME or String constant.
"SCNVAL" -- value of (1st word of) numeric constant. Second
word, if any, is the adjacent word DBLVAL.
"HPNT" -- The instr which when executed will load LPSA with
the correct bucket in the right half. SHASH, NHASH set up.
"NEWSYM" -- if ≠0, →block matching PNAME or SCNVAL. This ptr
is set by SCAN, STRINS, etc., using SHASH, NHASH. If -0,
this is the first occurrence of the symbol.
Also, the prodef bit in ff is used to tell if the symbol is a formal param
RES "NEWSYM"←pointer to new block.
SID Uses A,C, TBITS, LPSA, TEMP; alters symbol table structure
⊗
↑ENTERS:
MOVE TBITS,BITS ;TYPE BITS
TLNE TBITS,CNST ;CONSTANT?
JRST ENCNST ; YES
; ENTER AN IDENTIFIER -- CHECK FOR RESERVED (ERROR), FORWARD
; PROCEDURE BEING DEFINED. CHECK LEVEL VALIDITY FOR REDEFINED
; SYMBOLS
ENIDNT:
MOVE C,LEVEL ;CURRENT LEVEL OF DEFINITION
SKIPG LPSA,NEWSYM ;IS THIS THE FIRST OCCURRENCE?
JRST BRANEW ; YES
;;#JZ# 11-4-72 HJS (1-2) CHANGE MACRO SCOPE
;;#JZ# THIS GROUP AND THE NEXT WERE INTERCHANGED
SETCM TEMP,$TBITS(LPSA);PREVIOUS TYPE BITS, COMPLEMENTED
SKIPL $TBITS(LPSA) ; CHECK FOR REDEFINITION OF A RESERVED WORD AS
; AS A MACRO (HJS 11-19-72)
TLNN TBITS,DEFINE ;SPECIAL TREATMENT FOR REDEFINITION
JRST NODEFN ; IT ISN'T ONE (HJS 11-19-72)
;; #LC# (1-17-73) HJS MACRO FORMAL,NOT MACRO REDEFINITION
TLNE TBITS,FORMAL ;
JRST NODEFN ;MACRO FORMAL, NOT MACRO REDEFINTION
;; #LC#
TLNN TEMP,DEFINE
JRST DFEN1 ; IT IS ONE
;;#JZ# (1-2)
;;#JZ# 11-4-72 HJS (2-2) WAS INTERCHANGED WITH ABOVE
NODEFN: LDB A,PLEVEL ;OLD LEVEL OF DEFINITION (HJS 11-19-72)
SKIPL $TBITS(LPSA) ;IF OLD WAS RESERVED WORD, THEN OK.
CAMLE C,A ;C=CURRENT -- MUST BE GREATER
JRST OKOLD ; AND IS
CAME C,A ;IF =, MAY BE FORWARD COMING
ERR <SAIL IN LEVEL TROUBLE>,1
;;#JZ# 2-2
CHKPRC: SETCM A,TBITS ;NEW BITS
;; SUGG BY R. SMITH LOAD A BEFORE TRNN
TRNN TEMP,PROCED!FORWRD; MUST BE FORWARD PROCEDURE
JRST ISPRC
TLO A,OWN ;THIS IS SORT OF IRRELEVANT
TLO TEMP,OWN
TLOE TEMP,EXTRNL
ERR <DUPLICATE IDENTIFIER DECLARATION>,1,BRANEW ; ISN'T ANY GOOD!
TLC A,INTRNL ;SHOULD BE ON (=0), TURN OFF (=1) OR ON (ERROR)
CAME A,TEMP
ERR <DUPLICATE IDENTIFIER DECLARATION>,1,BRANEW ; ISN'T ANY GOOD!
MOVEM TBITS,$TBITS(LPSA)
PUSHJ P,URGVRB
PUSHJ P,RNGVRB
POPJ P,
ISPRC: TRNN TBITS,PROCED ;THIS SHOULD ALSO BE A PROCEDURE
ERR <DUPLICATE IDENTIFIER DECLARATION FOR >,3,BRANEW
; FORWARD PROCEDURE BEING DEFINED NOW, CHECK VALIDITY, CHANGE BITS
TRZE A,FORWRD ;TO MATCH OLD(COMPLEMENTED)
TLNN A,EXTRNL ;MAKE SURE NOT DUPLICATE EXTERNAL
ERR <DUPLICATE FORWARD/EXTERNAL DECLARATION FOR >,3,NOPROG
;;#JX#2↓ 11-2-72 DCS ALLOW INTERNAL PROC TO OVERRIDE EXTERNAL PROC.
TLON TEMP,EXTRNL ;Turn off EXTRNL in old, but if it was on, flip
TLC A,INTRNL ; INTRNL in new (will turn it off was on -- correct)
;;#JX#
CAME A,TEMP ;CHECK MATCHING TYPES
ERR <FORWARD TYPE DISAGREES>,1
TRO TBITS,INPROG ;MARK PROCEDURE UNDER DEFINITION
MOVEM TBITS,$TBITS(LPSA) ;STORE NEW
NOPROG: PUSHJ P,URGVRB ;REMOVE FROM VARB RING
PUSHJ P,RNGVRB ;PUT BACK ON THE END
LEFT ,%TLINK,LPSERR ;→SECOND BLOCK
LEFT (,%TLINK)
;;#GP# DCS 2-6-72 (2-4) CHECK OLD FORMALS AGAINST ACTUAL ONES
HRRZM LPSA,OLDPRM ;SAVE OLD FORMALS -- USED TO KILLST HERE
POPJ P, ;FOR A BIT LATER
;;#GP# (2)
; REDEFINITION IF NOT A PARAMETER TO A MACRO
DFEN1: TLNN TEMP,FORMAL ;BITS ARE COMPLEMENTED HERE, CAN'T BE FORMAL
ERR <DUPLICATE IDENTIFIER DECLARATION>,1
POPJ P, ; GET OUT IF MACRO REDEFINITION AT THE SAME
; LEVEL. BODY IS DELETED IN DFENT IF
; %TLINK IS NON-ZERO
; NOW CREATE A NEW BLOCK, PUT STUFF IN IT
BRANEW: ;NO CHECKING WAS DONE
OKOLD: ;IT'S ALL OK
GETBLK NEWSYM ;GET A NEW BLOCK
; INSERT PNAME, BITS -- LINK TO BUCKET, STRING RING,(VARB IF ID)
MOVE LPSA,NEWSYM ;POINTER TO NEW BLOCK
HRROI TEMP,PNAME+1 ;GET PDP FOR POPPING DATA
POP TEMP,$PNAME+1(LPSA) ;STORE STUFF
POP TEMP,$PNAME(LPSA)
;CREFFING FOR THE WORLD.
TLNE FF,CREFSW
PUSHJ P,ECREFIT
TRNN TBITS,PROCED ;PROCEDURE?
JRST NOPROC ;NO
MOVE PNT,LPSA
GETBLK ;SECOND PROCEDURE BLOCK
HRLM LPSA,%TLINK(PNT) ;%TLINK → 2D BLOCK
MOVE LPSA,PNT
TRNN TBITS,FORTRAN ;A FORTRAN CALL?
TLNE TBITS,EXTRNL ;OR EXTERNAL
TRO TBITS,FORWRD ;TURN ON FORWARD.
TRNN TBITS,FORWRD ;A FORWARD PROCEDURE?
TRO TBITS,INPROG ;NO -- TURN ON IN PROGRESS.
NOPROC: MOVEM TBITS,$TBITS(LPSA) ;TYPE BITS
SKIPE C,SIMPSW ;IF SIMPLE
AOJA C,FILLEV ;CLEVER TRICK TO LOAD C 0 & GO PUT IN LL
TRNN TBITS,LABEL ;OR NOT A LABEL, DONT CARE
JRST DOLL ;GO DO LEVELS
MOVE C,TPROC ;PICK UP CURRENT PROCEDURE
HRRZ C,$VAL(C) ;PICK UP PD SEMBLK
HRLM C,$ACNO(LPSA) ;PUT AWAY FOR LABEL SEMBLK
;#HY# RHT 6-26-72 OWN WAS BEING TESTED AS A RIGHT HALF BIT
DOLL: SKIPE C,CDLEV ;PICK UP DISPLY LEVEL
;;#IU# 8-12-72 ↓ RHT PREVENT EXTERNALS FROM BEING REFD (RF)
TLNE TBITS,OWN!EXTRNL;IF NON-ZERO DISPLY LEV, BUT OWN, OK
;;#LS# RHT 2↓ 3-12-73 WAS GETTING TO FILLEV WITH NOD ZERO C FOR OWN&EXTERNAL
JRST [SETZM C ;NO WORRY, ID IS AT LEVEL 0
JRST FILLEV]
SKIPE RECSW ;IF CURRENT PROC IS RECURSVE
;#HY# RHT HERE IS WHERE OWN WAS BEING TESTED
TRNE TBITS,ITEM!LABEL!PROCED; YES, IF NOT ITEM,LABEL, OR PROC THEN USE
;STACK
TLNE FF,PRODEF ;IF FORMAL USE STACK -- PRODEF SAYS WAS AN ARG LST
LSH C,LLFLDL ;SHIFT LEVEL T RIGHT SPOT
TRZ C,LLFLDM
;MASK OUT LEX LEV FLD AREA
FILLEV: TDO C,LEVEL ;PUT IN THE LEX LEVEL
HRRZM C,$SBITS(LPSA) ;LEVEL OF DEFINITION
; LINK TO BUCKET, STRING RING
TLNN FF,DEFLUK ; DON'T PUT PARAMETERS TO MACROS OR
SKIPE DLMSTG ; MACRO BODIES OR SPECIALLY DELIMITED
JRST STRPUT ; STRINGS ON BUCKET
MOVEI A,LNKRET+1 ;IN-LINE "CALL"
LNK: MOVE B,HPNT ;WORD SET UP BY HASH
XCT B ;THIS PICKS UP THE TIE INTO LPSA
MOVE TEMP,NEWSYM ;POINTER TO NEW ONE
HRRM LPSA,%TBUCK(TEMP) ;LINK DOWN NEW BLOCK
HRR LPSA,TEMP ;GET LPSA READY TO PUT BACK
TLO B,2000 ;TURN ON "MOVE TO MEMORY" BIT
XCT B
LNKRET: JRST (A) ;ALL DONE
STRPUT: MOVE LPSA,NEWSYM
PUSHJ P,RNGSTR ;PUT ON STRING RING
; IF NOT A CONSTANT, LINK TO VARB LIST -- RETURN
VRBLNK: TLNE FF,PRMSCN ;PUT ON VARB RING IF ACTUAL PARAM
JRST VRBMAK ; TO DEFINE
TLNE TBITS,CNST ;NOT ON VARB IF CONST
POPJ P, ; DONE
VRBMAK: MOVE LPSA,NEWSYM
JRST RNGVRB ;PUT ON VARB RING
Comment ⊗ Constants, String or Numeric ⊗
ENCNST: TRNN TBITS,STRING ;STRING CONSTANT?
JRST ENNUMB ; NO, NUMERIC
ENSTRNG:
MOVEI C,0 ;STRCONS ARE AT LEVEL 0
PUSHJ P,BRANEW ;USE VARIABLE STUFF TO PERFORM THE ENTER.
MOVE LPSA,NEWSYM ;SEMANTICS OF RESULT
HLLZS $SBITS(LPSA) ;NO LEVELS FOR STRING CONSTANTS
TLNN FF,DEFLUK ; ALREADY LINKED ON %RVARB IF
SKIPE DLMSTG ; AN ACTUAL DEFINE PARAM, MACRO BODY, OR
POPJ P, ; A SPECIALLY DELIMITED STRING
PUSHJ P,RNGCST ;PUT ON CONSTANT RING.
POPJ P,
; NUMERIC CONSTANT
ENNUMB:
GETBLK NEWSYM
HRROI TEMP,DBLVAL ;STORE STUFF
POP TEMP,$VAL+1(LPSA)
POP TEMP,$VAL(LPSA)
POP TEMP,$TBITS(LPSA)
SKIPN DLMSTG ; SPECIAL DELIMITER MODE?
TLNE FF,DEFLUK ; AOMPILE TIME ASSIGNMENT (I.E. MACRO BODY)
POPJ P, ; DON'T LINK, RETURN
JSP A,LNK ;LINK TO BUCKET LIST
PUSHJ P,RNGCNM ;PUT ON CONSTANT RING
POPJ P,
DSCR ADCINS, CREINT, CONINS
CAL PUSHJ from EXECS which create constants for runtime.
PAR A contains value for CREINT, ADCINS
SCNVAL contains value for CONINS (numeric)
BITS contains type bits for CONINS
PNAME string is value for CONINS (String)
RES Semantics for constant (new or used) in rh of PNT
DES These routines are used to create constants, for
adjusting the stack, doing compile-time computation
of constant expressions, providing address constants, etc.
CONINS uses SCNVAL and BITS to make a constant of the
proper flavor (PNAME string for String constants).
CREINT makes an Integer constant.
ADCINS is CONINS, except it forces a new constant to be
made (code in SCANNER does it). It is used to provide
unique addresses for REFERENCE calls, which might wipe
the values out.
SID All AC's except PNT preserved; lh PNT preserved.
⊗
↑ADCINS:
MOVEM A,SCNVAL ;SPECIAL UNIQUE CONSTANT FOR
MOVE TBITS,[XWD CNST+RECURS,0] ;ADCON MAKER
ORM TBITS,BITS ;(CONSTANT BY REFERENCE)
JRST CONINS ;CONTINUE
↑CREINT: MOVEM A,SCNVAL ;CREATE AN INTEGER
SKIPA TBITS,[XWD CNST,INTEGR]
↑CONINS: MOVE TBITS,BITS
;;# # DCS 3-1-72
TRNE TBITS,STRING ;INSERT A STRING IF REQUESTED
JRST STRINS
;;# #
PUSH P,NUM1 ;FLAGS
PUSH P,NUM2
CINS: MOVE TEMP,[XWD A,CONACS]
BLT TEMP,CONACS+SBITS2-A
MOVE LPSA,STRCON ;STRING CONSTANT BUCKET.
MOVEM TBITS,BITS
XCT -1(P) ;HASH AND LOOKUP
MOVE TBITS,TBITS+CONACS-A
MOVEM TBITS,BITS
SKIPN NEWSYM ;WAS IT FOUND?
XCT (P) ;NO -- ENTERS
MOVE TEMP,[XWD CONACS,A]
BLT TEMP,SBITS2
SUB P,X22
HRR PNT,NEWSYM ;DO NOT CLOBBER LEFT HALF INCASE
; ADCONS ARE BEING MADE.
JRST GETAD
↑STRINS: PUSH P,STR1 ;FOR STRINGS
PUSH P,STR2
MOVE TBITS,[XWD CNST,STRING]
JRST CINS ;GO DO IT.
NUM1: PUSHJ P,NHASH
NUM2: PUSHJ P,ENNUMB
STR1: PUSHJ P,SHASH
STR2: PUSHJ P,ENSTRNG
ZERODATA (AC SAVE AREA FOR CONSTANT-MAKERS)
CONACS: BLOCK SBITS2-A+1
ENDDATA
SUBTTL HASH ROUTINES
DSCR SHASH, NHASH -- look up symbol entries in hashed buckets.
PAR LPSA -- →bucket Semblk for SHASH (since there are two).
NHASH supplies its own.
PNAME -- String search argument for SHASH
SCNVAL -- Numeric search argument for NHASH
RES HPNT -- [HRRZ LPSA, bucketaddr] or [HLRZ LPSA, bucketaddr]
as explained in HPNT declaration.
NEWSYM -- 0 if not found, else Semantics of found entity.
SID Uses TEMP, TBITS, A, B, C, D, PNT -- Results in LPSA
SEE HPNT, NEWSYM, Bucket descriptions in main SAIL DATA area
⊗
↑SHASH:
MOVE A,PNAME+1 ;BYTE POINTER
MOVE A,(A) ;1ST STRING WORD
HRRZ TEMP,PNAME ;#CHARACTERS
XOR A,TEMP ;MIX IT UP A BIT
PUSHJ P,HASH ;COMPUTE HASH, GET POINTER, STORE IN HPNT
Comment ⊗ Search for symbol identical to string in pname.
Put pointer to it in NEWSYM if found.
Computed hash pointer is in HPNT on entry ⊗
SFIND: SETZM NEWSYM ;ASSUME NOT FOUND
HRRZ A,PNAME ;LENGTH
JUMPE A,BUKS ;ZERO LENGTH PNAME TEST
MOVEI B,4(A)
IDIVI B,5 ;# WORDS IN B
HRLI PNT,D ;SET UP INDICES
HRR PNT,PNAME+1 ;BYTE POINTER TO NEW NAME
HRLI C,D
MOVE TBITS,(PNT) ;FIRST WORD OF NEW NAME
JRST BUKS ;START AT THIS ONE
BUKLS: RIGHT ,%TBUCK,, ;GO DOWN BUCKET
BUKS: JUMPE LPSA,NOFND ;IN CASE BUCKET WAS EMPTY
JUMPE A,LCOMP ;ZERO LENGTH PNAME TEST
CAME TBITS,@$PNAME+1(LPSA) ;SAME FIRST WORD?
JRST BUKLS ;NO , FAIL
LCOMP: HRR TEMP,$PNAME(LPSA) ;LENGTH OF OBJECT STRING
CAIE A,(TEMP) ;SAME LENGTH?
JRST BUKLS ;NO -- FAILURE
JUMPE A,FND ;IF BOTH LENGTH(0), ASSUME IDENTICAL
HRREI D,-1(B) ;# WORDS-1
JUMPLE D,FND ;SAME SYMBOL, ONE WORD LONG
HRR C,$PNAME+1(LPSA);BYTE POINTER ADDR -- INDEX
SFNLUP: MOVE TEMP,@PNT
CAME TEMP,@C ;SAME WORD?
JRST BUKLS ;FAILURE
SOJG D,SFNLUP ;KEEP AT IT!
FND: MOVEM LPSA,NEWSYM
NOFND: POPJ P,
; USES A,B only -- results in LPSA
↑NHASH: SETZM NEWSYM ;ASSUME FAILURE
MOVE A,SCNVAL ;HASH ON 1ST WORD OF VALUE
MOVE LPSA,CONST ; HASH TO CONST BUCKET
PUSHJ P,HASH
MOVE A,SCNVAL ;GET VALUES FOR COMPARISON
MOVE B,DBLVAL
MOVE TEMP,BITS
TLNE TEMP,RECURS ;WANT UNIQUE CONSTANT?
JRST NOFND ; YES, SAME AS FAILURE
JRST BUK ;START HERE
BUKL: RIGHT ,%TBUCK ;DOWN BUCKET LIST
BUK: JUMPE LPSA,NOFND ;BE SURE TO CHECK THE FIRST ONE
CAME A,$VAL(LPSA) ;FIRST VALUE EQUAL?
JRST BUKL ;NO -- FAILURE
CAME B,$VAL2(LPSA) ;SECOND VALUE EQUAL?
JRST BUKL ;NO -- FAILURE
MOVE TEMP,BITS ;MAKE SURE TYPE IS SAME
CAME TEMP,$TBITS(LPSA)
JRST BUKL ;STILL CAN'T USE IT
JRST FND ;OK, USE IT
JRST FND ;FINISH OUT
Comment ⊗ HASH routine itself --
IN: A -- number to be hashed
LPSA -- bucket pointer
OUT: HPNT contains an instruction which, when executed
will load LPSA with the bucket word in the RH.
See LNK above for the cute way of entering
the new symbol.
ACS: uses A, B -- results in LPSA
⊗
HASH: IDIVI A,BUKLEN ;GET (A mod BUKLEN)
MOVMS B ;USE MAGNITUDE
ROT B,-1 ;DIVIDE BY TWO
ADD LPSA,B ;ADD TO THE BUCKET POINTER
HRLI LPSA,(<MOVE LPSA,0>)
SKIPL B
HRLI LPSA,(<MOVS LPSA,0>)
MOVEM LPSA,HPNT ;AND STORE AWAY
XCT LPSA
HRRZS LPSA ;SO THE JUMPE WILL WORK.
POPJ P,
SUBTTL SEMBLK Allocation Routines
DSCR BLKGET, BLKFRE -- Semblk Allocators
CAL PUSHJ via GETBLK, FREBLK macros.
DES Routines to perform the following:
BLKGET allocates a new 11-word Semblk.
BLKFRE restores such a Semblk to the BLFREE storage list
SETBLK Initializes BLFREE with blocks as determined by
determined by the area allocated in lpsbot, lpstop.
NEEBLK Gets more blocks when you need them
BLKZER Zeroes the block pointed to by LPSA
PAR LPSA is Semblk address for BLKFRE
RES LPSA contains Semblk address from BLKGET
SID USER used for GOGTAB by SET-&NEE- blk
TEMP destroyed by same
LPSA changed by SETBLK and BLKZER, set to good thing by NEEBLK
⊗
ZERODATA (BLOCK-GETTER VARIABLES)
COMMENT ⊗
BLFREE -- Semblk Free Storage List pointer. Points to first Semblk
on list, whose first word points to next, etc. -- 0 terminates.
Semblks are put on the list by BLKZER when allocating more, and
by the BLKFRE (via FREBLK macro) routine. They are removed by
the BLKGET (via GETBLK macro) routine.
⊗
↑↑BLFREE: 0
;FRECNT -- # free blocks when enabled by FTCOUNT switch
IFN FTDEBUG, <
↑↑FRECNT: 0
>
TSTALO←←0 ;SPECIAL TEST MODE FOR BLOCK ALLOCATOR
IFNDEF TSTALO, <TSTALO←←0>
IFE TSTALO,<BLLEN←←BLKLEN; ELSE>BLLEN←←BLKLEN+2 ;SET TOTAL BLOCK SIZE
IFN TSTALO, <BLKUSE: 0>
ENDDATA
↑SETBLK:
IFN TSTALO ,<
MOVEI TEMP,BLKUSE-BLKLEN-1 ;initialize pointer to
HRLS TEMP ;doubly-linked list of IN USE
MOVEM TEMP,BLKUSE ; blocks for finding lacking FREBLKs
>;TSTALO
MOVE TEMP,LPSBOT
SETBL1: MOVEM TEMP,BLFREE ;STARTING ADDRESS
GOK: MOVEI LPSA,BLLEN(TEMP) ;NEXT AREA
CAML LPSA,LPSTOP ;TOO FAR?
JRST SETD
MOVEM LPSA,(TEMP) ;STORE THE POINTER
MOVE TEMP,LPSA
JRST GOK
SETD: SUBI TEMP,BLLEN ;GO BACK AND
SETZM (TEMP) ;TERMINATE LIST
POPJ P,
↑NEEBLK:
PUSH P,B ;NEEDED FOR CORE GETTERS
PUSH P,C
MOVE B,LPSBOT ;TRY TO INCREMENT THIS BLOCK
MOVEI C,=100*BLLEN ;TRY TO INCREMENT THIS BLOCK
PUSHJ P,CANINC ;IS IT POSSIBLE?
JRST NOINC ;NO
JRST INCR3 ;YES, GO DO IT
NOINC:
CAIGE C,=20*BLLEN ;WILL SETTLE FOR THIS
JRST GETTOP ;NO, GET NEW BLOCK
INCR3: PUSHJ P,CORINC ;EXPAND BY ALLOWABLE AMOUNT
ERR <DRYROT> ;CAN'T HAPPEN
EXCH C,LPSTOP ;OLD TOP IS NEW FREE AREA
ADDM C,LPSTOP ;NEW UPPER LIMIT
MOVE TEMP,C ;SO LEAVE IT WHERE IT WILL BE NOTICED
JRST NEERT1 ;NOW GO AND RELINK
GETTOP: MOVEI C,=100*BLLEN ;GET NEW BLOCK THIS SIZE
PUSHJ P,CORGET
JRST CORERR ;CAN'T GET ENOUGH
MOVEM B,LPSBOT ;SET LIMITS ANEW
MOVEM B,LPSTOP
ADDM C,LPSTOP
NEERET:
MOVE TEMP,B ;→BOTTOM OF NEW
NEERT1: POP P,C
POP P,B
PUSHJ P,SETBL1 ;LINK THEM UP
MOVE LPSA,BLFREE ;SO THAT WE CAN CONTINUE
POPJ P,
↑BLKGET:
IFN FTDEBUG,<AOS FRECNT>
SKIPN LPSA,BLFREE
PUSHJ P,NEEBLK ;GET A WHOLE NOTHER SET.
MOVE TEMP,(LPSA)
MOVEM TEMP,BLFREE ;UPDATE FREE STORAGE.
↑BLKZER: SETZM (LPSA) ;FIRST WORD
MOVSI TEMP,(LPSA) ;ZERO THE BLOCK
HRRI TEMP,1(LPSA)
BLT TEMP,BLLEN-1(LPSA)
IFN TSTALO,<
; ADD BLOCK TO DOUBLY-LINKED RING OF IN USE BLOCKS
POP P,BLKLEN(LPSA) ;SAVE RET ADDR FOR HISTORY OF CALL TO BLKGET
HLRZ TEMP,BLKUSE ;GET POINTER TO LAST BLOCK IN RING
HRLM LPSA,BLKUSE ;UPDATE SAID POINTER
HRRM LPSA,BLKLEN+1(TEMP) ;UPDATE FOR'RD PNTR IN OLD LAST BLOCK
HRLM TEMP,BLKLEN+1(LPSA) ;UPDATE BCK'RD PNTR IN NEW (LAST) BLOCK
MOVEI TEMP,BLKUSE-BLKLEN-1 ;UPDATE FOR'RD PNTR IN NEW BLOCK
HRRM TEMP,BLKLEN+1(LPSA)
JRST @BLKLEN(LPSA) ;RETURN DEVIOUSLY
; ELSE >POPJ P,
↑BLKFRE:
IFN FTDEBUG,<SOS FRECNT>
EXCH LPSA,-1(P) ;GET ARG, SAVE LPSA
MOVE TEMP,BLFREE
HRRZM TEMP,(LPSA) ;STRINGOUT FREE STORAGE
HRRM LPSA,BLFREE
IFN TSTALO, <
; REMOVE FROM IN USE RING
MOVE TEMP,BLKLEN+1(LPSA) ;BCK'RD,,FOR'RD
HLLM TEMP,BLKLEN+1(TEMP) ;UPDATE BCK'RD IN NEXT TO → PREV
MOVSS TEMP
HLRM TEMP,BLKLEN+1(TEMP) ;UPDATE FOR'RD IN LAST TO → NEXT
>
MOVE LPSA,-1(P) ;GET OLD VALUE BACK
SUB P,X22
JRST @2(P)
SUBTTL RNGVRB, RNGSTR, etc. -- `Ring' Linkage Routines
DSCR RNGSTR, RNGGEN, RNGTMP, RNGCST, RNGVRB, RNGADR, RNGCNM
PAR (Sometimes) LPSA is Semblk address
RES The Semblk is linked onto a `ring' based on a variable
implied by the routine name. RNGSTR uses %RSTR -- all others
use %RVARB. The ring header variables are STRRNG, VARB, TTEMP,
CONINT, CONSTR, ADRTAB.
DES These routines replace the RING macro -- for space efficiency.
⊗
↑RNGDIS:MOVEI TEMP,DISLST ;DISPLAY TEMPS
JRST RNGGEN
↑RNGADR:SKIPA TEMP,[ADRTAB] ;ADDRESS CONSTANTS
↑RNGTMP:MOVEI TEMP,TTEMP ;CORE TEMPS
JRST RNGGEN
↑RNGCNM:SKIPA TEMP,[CONINT] ;NUMERICAL CONSTANTS -- ASSUMES NEWSYM
↑RNGCST:MOVEI TEMP,CONSTR ;STRING CONSTANTS -- ASSUMES NEWSYM
SKIPA LPSA,NEWSYM ;GET SEMBLK FROM HERE
↑RNGVRB:MOVEI TEMP,VARB ;VARB RING
RNGGEN: PUSH P,A
SKIPN A,(TEMP) ;The left half of %RVARB(Semblk) is
JRST .+3 ; made to point to the previous `newest'
HRRM LPSA,%RVARB(A) ; Semblk, if one exists -- the right
HRLZM A,%RVARB(LPSA) ; half of %RVARB(Previous) points to
MOVEM LPSA,(TEMP) ; this one -- the vase vbl (TEMP) always
POP P,A ; indicates the new (right-hand) end
POPJ P, ; of the list -- the oldest lh is always 0
↑RNGSTR:SKIPN TEMP,STRRNG ;String ring linkage -- same business
JRST .+3
HRRM LPSA,%RSTR(TEMP)
HRLZM TEMP,%RSTR(LPSA)
MOVEM LPSA,STRRNG
POPJ P,
DSCR URGVRB, URGADR, URGTMP, URGCST, URGSTR
PAR LPSA is a Semblk Address
The Header vbl is set up by calling the right routine
DES Undoes the damage done by RING
⊗
↑URGDIS:SKIPA TEMP,[DISLST]
↑URGCNM:MOVEI TEMP,CONINT
JRST URGGEN
↑URGVRB:SKIPA TEMP,[VARB]
↑URGTMP:MOVEI TEMP,TTEMP
JRST URGGEN
↑URGADR:SKIPA TEMP,[ADRTAB]
↑URGCST:MOVEI TEMP,CONSTR
URGGEN: PUSH P,A ;If there are no pointers in %RVARB, then
SKIPN A,%RVARB(LPSA) ;1) The Semblk is not on the ring, or:
CAMN LPSA,(TEMP) ;2) It is the only member, in which case its
JRST DOU ; address is that of the header vbl (TEMP)
ENDU: POP P,A ;So you get here immediately in CASE 1 above,
POPJ P, ; and after you've unlinked in other cases.
DOU: TRNE A,-1 ;If there is a younger neighbor, tell him
HLLM A,%RVARB(A) ; you're gone.
TRNN A,-1 ;If there is not a younger neighbor, update
HLRZM A,(TEMP) ; the header, because you were youngest.
MOVSS A
TRNE A,-1 ;If there is an older neigbor, tell him
HLRM A,%RVARB(A) ; you're gone.
JRST ENDU
↑URGSTR:SKIPN TEMP,%RSTR(LPSA);Same stuff for string ring.
CAMN LPSA,STRRNG
JRST DOST
POPJ P,
DOST: TRNE TEMP,-1
HLLM TEMP,%RSTR(TEMP)
TRNN TEMP,-1
HLRZM TEMP,STRRNG
MOVSS TEMP
TRNE TEMP,-1
HLRM TEMP,%RSTR(TEMP)
POPJ P,
SUBTTL Mark insertion routine for counter routines
DSCR LSTOUT -- write to list file
CAL PUSHJ P,LSTOUT
PAR Reg A contains character to be listed
RES The character right justified in A is placed in the output
line of the list file. If the last character was a CR, the character
is inserted before the CR. This routine is called by the exec
routines KOUNT1, KOUNT2, etc. to put markers in the list file
indicating where counters were placed into the object code.
SID the contents of A may be changed.
⊗
↑LSTOUT: PUSH P,B ;SAVE B
LDB B,LPNT ;GET PREV LAST CHAR
CAIE B,15 ;IS IT A CR
JRST .+3 ;NO
DPB A,LPNT ;YES, WIPE IT OUT
MOVEI A,15 ;AND PUT CR AFTER IT
IDPB A,LPNT ;STORE CHAR
POP P,B ;RESTORE B
POPJ P, ;RETURN
DSCR LSTOU1 -- Write to list file
CAL PUSHJ P,LSTOU1
PAR Reg A contains character to be listed
Reg C contains character that the char in A should follow
RES If the last character in the line matches the one in
C, the character in A is put at the end of the line. If
not, the char in A is placed before the last character.
The necessity for doing this comes from the fact that some
single character tokens are placed in the listing file before
they are parsed.
SID Register A may be changed
⊗
↑LSTOU1: PUSH P,B ;SAVE B
LDB B,LPNT ;GET THE LAST CHAR
CAMN B,C ;IS IT THE ONE WE WANT...
JRST .+8 ;YES, GO STORE CHARACTER
CAIGE C,"A" ;IS THE COMPARE CHAR A LETTER
JRST .+4 ;NO
ADDI C,"a"-"A" ;CONVERT TO LOWERCASE
CAMN B,C ;IS IT THE RIGHT THING?
JRST .+3 ;YES, GO STORE CHARACTER AND RETURN
DPB A,LPNT ;NO, STORE NEW CHAR
MOVE A,B ;THEN OLD CHARACTER
IDPB A,LPNT
POP P,B ;RESTORE B
POPJ P, ;RETURN
BEND SYM
↑KILLST←KILLST
SUBTTL Generator Data